lilalo: 2c00c61f2d7b l3-agent

lilalo

view l3-agent @ 100:2c00c61f2d7b

Коммичу изменения, но сам не знаю зачем.
Нужно l3-cgi переписать вообще с нуля.
Он мерзкий.

И продумать нужно, как он вообще должен работать.
Понятно, приблизительно, как он должен показывать журнал,
когда до него уже дошли,
но вот если не дошли, то что делать не понятно.
Короче, продумать систему навигации.

author	devi
date	Wed Jun 14 21:37:22 2006 +0300 (2006-06-14)
parents	3058ada85a58
children	0d49f33696b3

line source

1 #!/usr/bin/perl -w

4 # (c) Igor Chubin, igor@chub.in, 2004-2006

8 ## Эта строчка добавлена из блокнота Windows

9 ## Надо отдать должное, он каким-то образом научился понимать кодировку

11 use strict;

12 use POSIX;

13 use Term::VT102;

14 use Text::Iconv;

15 use Time::Local 'timelocal_nocheck';

16 use IO::Socket;

18 use lib "/usr/local/bin";

19 use l3config;

22 our @Command_Lines;

23 our @Command_Lines_Index;

24 our %Diffs;

25 our %Sessions;

27 our %Script_Files; # Информация о позициях в скрипт-файлах,

28 # до которых уже выполнен разбор

29 # и информация о времени модификации файла

30 # $Script_Files{$file}->{size}

31 # $Script_Files{$file}->{tell}

33 our $Killed =0; # В режиме демона -- процесс получил сигнал о завершении

35 sub init_variables;

36 sub main;

38 sub load_diff_files;

39 sub bind_diff;

40 sub extract_commands_from_cline;

41 sub load_command_lines;

42 sub sort_command_lines;

43 sub print_command_lines;

44 sub printq;

46 sub save_cache_stat;

47 sub load_cache_stat;

48 sub print_session;

50 sub load_diff_files

52 my @pathes = @_;

53

54 for my $path (@pathes) {

55 my $template = "*.diff";

56 my @files = <$path/$template>;

57 my $i=0;

58 for my $file (@files) {

60 next if defined($Diffs{$file});

61 my %diff;

63 # Старый формат имени diff-файла

64 # DEPRECATED

65 if ($file=~m@/(D?[0-9][0-9]?[0-9]?)[^/]*?([0-9]*):([0-9]*):?([0-9]*)@) {

66 $diff{"day"}=$1 || "";

67 $diff{"hour"}=$2;

68 $diff{"min"}=$3;

69 $diff{"sec"}=$4 || 0;

71 $diff{"uid"} = 0 if $path =~ m@/root/@;

73 print "diff loaded: $diff{day} $diff{hour}:$diff{min}:$diff{sec}\n";

75 }

76 # Новый формат имени diff-файла

77 elsif ($file =~ m@.*/([^_]*)_([0-9]+)(.*)@) {

78 $diff{"local_session_id"} = $1;

79 $diff{"time"} = $2;

80 $diff{"filename"} = $3;

81 $diff{"filename"} =~ s@_@/@g;

82 $diff{"filename"} =~ s@//@_@g;

84 print "diff loaded: $diff{filename} (time=$diff{time},session=$diff{local_session_id})\n";

85 }

86 else {

87 next;

88 }

90 # Чтение и изменение кодировки содержимого diff-файла

91 local $/;

92 open (F, "$file")

93 or return "Can't open file $file ($_[0]) for reading";

94 my $text = <F>;

95 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i) {

96 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8");

97 $text = $converter->convert($text);

98 }

99 close(F);

100 $diff{"text"}=$text;

102 $diff{"path"}=$path;

103 $diff{"bind_to"}="";

104 $diff{"time_range"}=-1;

105 $diff{"index"}=$i;

107 $Diffs{$file} = \%diff;

108 $i++;

109 }

110 }

114 sub bind_diff

116 print "Trying to bind diff...\n";

118 my $cl = shift;

119 my $hour = $cl->{"hour"};

120 my $min = $cl->{"min"};

121 my $sec = $cl->{"sec"};

123 my $min_dt = 10000;

125 for my $diff_key (keys %Diffs) {

126 my $diff = $Diffs{$diff_key};

127 next if ($diff->{"local_session_id"}

128 && $cl->{"local_session_id"}

129 && ($cl->{"local_session_id"} ne $diff->{"local_session_id"}));

131 next if ($diff->{"day"} && $cl->{"day"} && ($cl->{"day"} ne $diff->{"day"}));

133 my $dt;

134 if ($diff->{"time"} && $cl->{"time"}) {

135 $dt = $diff->{"time"} - $cl->{"time"}

136 }

137 else {

138 $dt=($diff->{"hour"}-$hour)*3600 +($diff->{"min"}-$min)*60 + ($diff->{"sec"}-$sec);

139 }

140 if ($dt >0

141 && $dt < $min_dt

142 && ($diff->{"time_range"} <0

143 || $dt < $diff->{"time_range"})) {

144 print "Approppriate diff found: dt=$dt\n";

145 if ($diff->{"bind_to"}) {

146 undef $diff->{"bind_to"}->{"diff"};

147 };

148 $diff->{"time_range"}=$dt;

149 $diff->{"bind_to"}=$cl;

151 $cl->{"diff"} = $diff_key;

152 $min_dt = $dt;

153 }

154 }

158 sub extract_commands_from_cline

159 # Разобрать командную строку $_[1] и возвратить хэш, содержащий

160 # номер первого появление команды в строке:

161 # команда => первая позиция

163 my $cline = $_[0];

164 my @lists = split /\;/, $cline;

165

166

167 my @commands = ();

168 for my $list (@lists) {

169 push @commands, split /\|/, $list;

170 }

172 my %commands;

173 my %files;

174 my $i=0;

175 for my $command (@commands) {

176 $command =~ /\s*(\S+)\s*(.*)/;

177 if ($1 && $1 eq "sudo" ) {

178 $commands{"$1"}=$i++;

179 $command =~ s/\s*sudo\s+//;

180 }

181 $command =~ /\s*(\S+)\s*(.*)/;

182 if ($1 && !defined $commands{"$1"}) {

183 $commands{"$1"}=$i++;

184 };

185 }

186 return %commands;

189 sub load_command_lines

191 my $lab_scripts_path = $_[0];

192 my $lab_scripts_mask = $_[1];

194 my $cline_re_base = qq'

195 (

196 (?:\\^?([0-9]*C?)) # exitcode

197 (?:_([0-9]+)_)? # uid

198 (?:_([0-9]+)_) # pid

199 (...?) # day

200 (.?.?) # lab

201 \\s # space separator

202 ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) # time

203 .\\[50D.\\[K # killing symbols

204 (.*?([\$\#]\\s?)) # prompt

205 (.*) # command line

206 )

207 ';

208 my $cline_re = qr/$cline_re_base/sx;

209 my $cline_re2 = qr/$cline_re_base$/sx;

211 my $cline_re_v2_base = qq'

212 (

213 v2[\#] # version

214 ([0-9]+)[\#] # history line number

215 ([0-9]+)[\#] # exitcode

216 ([0-9]+)[\#] # uid

217 ([0-9]+)[\#] # pid

218 ([0-9]+)[\#] # time

219 (.*?)[\#] # pwd

220 .\\[1024D.\\[K # killing symbols

221 (.*?([\$\#]\\s?)) # prompt

222 (.*) # command line

223 )

224 ';

226 my $cline_re_v2 = qr/$cline_re_v2_base/sx;

227 my $cline_re2_v2 = qr/$cline_re_v2_base$/sx;

229 my $vt = Term::VT102->new ( 'cols' => $Config{"terminal_width"},

230 'rows' => $Config{"terminal_height"});

231 my $cline_vt = Term::VT102->new (

232 'cols' => $Config{"terminal_width"},

233 'rows' => $Config{"terminal_height"});

235 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8")

236 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i);

237

238 print "Parsing lab scripts...\n" if $Config{"verbose"} =~ /y/;

240 my $file;

241 my $skip_info;

243 my $commandlines_loaded =0;

244 my $commandlines_processed =0;

246 my @lab_scripts = <$lab_scripts_path/$lab_scripts_mask>;

247 for $file (@lab_scripts){

249 # Пропускаем файл, если он не изменялся со времени нашего предудущего прохода

250 my $size = (stat($file))[7];

251 next if ($Script_Files{$file} && $Script_Files{$file}->{size} && $Script_Files{$file}->{size} >= $size);

254 my $local_session_id;

255 # Начальное значение идентификатора текущего сеанса определяем из имени скрипта

256 # Впоследствии оно может быть уточнено

257 $file =~ m@.*/([^/]*)\.script$@;

258 $local_session_id = $1;

260 #Если файл только что появился,

261 #пытаемся найти и загрузить информацию о соответствующей ему сессии

262 if (!$Script_Files{$file}) {

263 my $session_file = $file;

264 $session_file =~ s/\.script/.info/;

265 if (open(SESSION, $session_file)) {

266 local $/;

267 my $data = <SESSION>;

268 close(SESSION);

270 for my $session_data ($data =~ m@<session>(.*?)</session>@sg) {

271 my %session;

272 while ($session_data =~ m@<([^>]*?)>(.*?)</\1>@sg) {

273 $session{$1} = $2;

274 }

275 $local_session_id = $session{"local_session_id"} if $session{"local_session_id"};

276 $Sessions{$local_session_id}=\%session;

277 }

279 #Загруженную информацию сразу же отправляем в поток

280 print_session($Config{cache}, $local_session_id);

281 }

282 else {

283 die "can't open session file";

284 }

285 }

287 open (FILE, "$file");

288 binmode FILE;

290 # Переходим к тому месту, где мы окончили разбор

291 seek (FILE, $Script_Files{$file}->{tell}, 0) if $Script_Files{$file}->{tell};

292 $Script_Files{$file}->{size} = $size;

293 $Script_Files{$file}->{tell} = 0 unless $Script_Files{$file}->{tell};

295 $file =~ m@.*/(.*?)-.*@;

297 print "\n+- processing file $file\n| "

298 if $Config{"verbose"} =~/y/;

300 my $tty = $1;

301 my $first_pass = 1;

302 my %cl;

303 my $last_output_length=0;

304 while (<FILE>) {

305 $commandlines_processed++;

307 next if s/^Script started on.*?\n//s;

309 if (/[0-9][0-9]:[0-9][0-9]:[0-9][0-9].\[[0-9][0-9]D.\[K/ && m/$cline_re/) {

310 s/.*\x0d(?!\x0a)//;

311 m/$cline_re2/gs;

313 $commandlines_loaded++;

314 $last_output_length=0;

316 # Previous command

317 my %last_cl = %cl;

318 my $err = $2 || "";

320 $cl{"local_session_id"} = $local_session_id;

321 # Parse new command

322 $cl{"uid"} = $3;

323 #$cl{"euid"} = $cl{"uid"}; # Если в команде обнаружится sudo, euid поменяем на 0

324 $cl{"pid"} = $4;

325 $cl{"day"} = $5;

326 $cl{"lab"} = $6;

327 $cl{"hour"} = $7;

328 $cl{"min"} = $8;

329 $cl{"sec"} = $9;

330 #$cl{"fullprompt"} = $10;

331 $cl{"prompt"} = $11;

332 $cl{"raw_cline"} = $12;

334 {

335 use bytes;

336 $cl{"raw_start"} = tell (FILE) - length($1);

337 $cl{"raw_output_start"} = tell FILE;

338 }

339 $cl{"raw_file"} = $file;

341 $cl{"err"} = 0;

342 $cl{"output"} = "";

343 $cl{"tty"} = $tty;

345 $cline_vt->process($cl{"raw_cline"}."\n");

346 $cl{"cline"} = $cline_vt->row_plaintext (1);

347 $cl{"cline"} =~ s/\s*$//;

348 $cline_vt->reset();

350 my %commands = extract_commands_from_cline($cl{"cline"});

351 #$cl{"euid"}=0 if defined $commands{"sudo"};

352 my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands;

353 $cl{"last_command"} = $comms[$#comms] || "";

355 if (

356 $Config{"suppress_editors"} =~ /^y/i

357 && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}})

358 || $Config{"suppress_pagers"} =~ /^y/i

359 && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}})

360 || $Config{"suppress_terminal"}=~ /^y/i

361 && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}})

362 ) {

363 $cl{"suppress_output"} = "1";

364 }

365 else {

366 $cl{"suppress_output"} = "0";

367 }

368 $skip_info = 0;

371 print " ",$cl{"last_command"};

373 # Processing previous command line

374 if ($first_pass) {

375 $first_pass = 0;

376 next;

377 }

379 # Error code

380 $last_cl{"raw_end"} = $cl{"raw_start"};

381 $last_cl{"err"}=$err;

382 $last_cl{"err"}=130 if $err eq "^C";

384 if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) {

385 bind_diff(\%last_cl);

386 }

388 # Output

389 if (!$last_cl{"suppress_output"} || $last_cl{"err"}) {

390 for (my $i=0; $i<$Config{"terminal_height"}; $i++) {

391 my $line= $vt->row_plaintext($i);

392 next if !defined ($line) ; #|| $line =~ /^\s*$/;

393 $line =~ s/\s*$//;

394 $line .= "\n" unless $line =~ /^\s*$/;

395 $last_cl{"output"} .= $line;

396 }

397 }

398 else {

399 $last_cl{"output"}= "";

400 }

402 $vt->reset();

405 # Save

406 if (!$Config{"lab"} || $cl{"lab"} eq $Config{"lab"}) {

407 # Changing encoding

408 for (keys %last_cl) {

409 next if /raw/;

410 $last_cl{$_} = $converter->convert($last_cl{$_})

411 if ($Config{"encoding"} &&

412 $Config{"encoding"} !~ /^utf-8$/i);

413 }

414 push @Command_Lines, \%last_cl;

416 # Сохранение позиции в файле, до которой выполнен

417 # успешный разбор

418 $Script_Files{$file}->{tell} = $last_cl{raw_end};

419 }

420 next;

421 }

424 elsif (m/$cline_re_v2/) {

427 # Разбираем командную строку версии 2

430 s/.*\x0d(?!\x0a)//;

431 m/$cline_re2_v2/gs;

433 $commandlines_loaded++;

434 $last_output_length=0;

436 # Previous command

437 my %last_cl = %cl;

439 $cl{"local_session_id"} = $local_session_id;

440 # Parse new command

441 $cl{"history"} = $2;

442 my $err = $3;

443 $cl{"uid"} = $4;

444 #$cl{"euid"} = $cl{"uid"}; # Если в команде обнаружится sudo, euid поменяем на 0

445 $cl{"pid"} = $5;

446 $cl{"time"} = $6;

447 $cl{"pwd"} = $7;

448 #$cl{"fullprompt"} = $8;

449 $cl{"prompt"} = $9;

450 $cl{"raw_cline"}= $10;

452 {

453 use bytes;

454 $cl{"raw_start"} = tell (FILE) - length($1);

455 $cl{"raw_output_start"} = tell FILE;

456 }

457 $cl{"raw_file"} = $file;

459 $cl{"err"} = 0;

460 $cl{"output"} = "";

461 #$cl{"tty"} = $tty;

463 $cline_vt->process($cl{"raw_cline"}."\n");

464 $cl{"cline"} = $cline_vt->row_plaintext (1);

465 $cl{"cline"} =~ s/\s*$//;

466 $cline_vt->reset();

468 my %commands = extract_commands_from_cline($cl{"cline"});

469 #$cl{"euid"} = 0 if defined $commands{"sudo"};

470 my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands;

471 $cl{"last_command"}

472 = $comms[$#comms] || "";

474 if (

475 $Config{"suppress_editors"} =~ /^y/i

476 && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}})

477 || $Config{"suppress_pagers"} =~ /^y/i

478 && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}})

479 || $Config{"suppress_terminal"}=~ /^y/i

480 && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}})

481 ) {

482 $cl{"suppress_output"} = "1";

483 }

484 else {

485 $cl{"suppress_output"} = "0";

486 }

487 $skip_info = 0;

490 if ($Config{verbose} =~ /y/i) {

491 print "\n| " if $commandlines_loaded % 5 == 1;

492 print " ",$cl{"last_command"};

493 }

495 # Processing previous command line

496 if ($first_pass) {

497 $first_pass = 0;

498 next;

499 }

501 # Error code

502 $last_cl{"err"}=$err;

503 $last_cl{"raw_end"} = $cl{"raw_start"};

505 if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) {

506 bind_diff(\%last_cl);

507 }

509 # Output

510 if (!$last_cl{"suppress_output"} || $last_cl{"err"}) {

511 for (my $i=0; $i<$Config{"terminal_height"}; $i++) {

512 my $line= $vt->row_plaintext($i);

513 next if !defined ($line) ; #|| $line =~ /^\s*$/;

514 $line =~ s/\s*$//;

515 $line .= "\n" unless $line =~ /^\s*$/;

516 $last_cl{"output"} .= $line;

517 }

518 }

519 else {

520 $last_cl{"output"}= "";

521 }

523 $vt->reset();

526 # Changing encoding

527 for (keys %last_cl) {

528 next if /raw/;

529 if ($Config{"encoding"} &&

530 $Config{"encoding"} !~ /^utf-8$/i) {

531 $last_cl{$_} = $converter->convert($last_cl{$_})

532 }

533 }

534 push @Command_Lines, \%last_cl;

536 # Сохранение позиции в файле, до которой выполнен

537 # успешный разбор

538 $Script_Files{$file}->{tell} = $last_cl{raw_end};

540 next;

542 }

544 # Иначе, это строка вывода

546 $last_output_length+=length($_);

547 #if (!$cl{"suppress_output"} || $last_output_length < 5000) {

548 if ($last_output_length < 50000) {

549 $vt->process("$_"."\n")

550 }

551 else

552 {

553 if (!$skip_info) {

554 print "($cl{last_command})";

555 $skip_info = 1;

556 }

557 }

558 }

559 close(FILE);

561 }

562 if ($Config{"verbose"} =~ /y/) {

563 print "\n`- finished.\n" ;

564 print "Lines loaded: $commandlines_processed\n";

565 print "Command lines: $commandlines_loaded\n";

566 }

572 sub sort_command_lines

574 print "Sorting command lines..." if $Config{"verbose"} =~ /y/;

576 # Sort Command_Lines

577 # Write Command_Lines to Command_Lines_Index

579 my @index;

580 for (my $i=0;$i<=$#Command_Lines;$i++) {

581 $index[$i]=$i;

582 }

584 @Command_Lines_Index = sort {

585 defined($Command_Lines[$index[$a]]->{"time"})

586 && defined($Command_Lines[$index[$b]]->{"time"})

587 ? $Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"}

588 : defined($Command_Lines[$index[$a]]->{"day"})

589 && defined($Command_Lines[$index[$b]]->{"day"})

590 && defined($Command_Lines[$index[$a]]->{"hour"})

591 && defined($Command_Lines[$index[$b]]->{"hour"})

592 && defined($Command_Lines[$index[$a]]->{"min"})

593 && defined($Command_Lines[$index[$b]]->{"min"})

594 && defined($Command_Lines[$index[$a]]->{"sec"})

595 && defined($Command_Lines[$index[$b]]->{"sec"})

596 ? $Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"}

597 || $Command_Lines[$index[$a]]->{"hour"} <=> $Command_Lines[$index[$b]]->{"hour"}

598 || $Command_Lines[$index[$a]]->{"min"} <=> $Command_Lines[$index[$b]]->{"min"}

599 || $Command_Lines[$index[$a]]->{"sec"} <=> $Command_Lines[$index[$b]]->{"sec"}

600 : 0

601 } @index;

603 print "finished\n" if $Config{"verbose"} =~ /y/;

607 sub printq

609 my $TO = shift;

610 my $text = join "", @_;

611 $text =~ s/&/&/g;

612 $text =~ s/</</g;

613 $text =~ s/>/>/g;

614 print $TO $text;

618 =cut

619 Вывести результат обработки журнала.

620 =cut

622 sub print_command_lines

624 my $output_filename=$_[0];

625 open(OUT, ">>", $output_filename)

626 or die "Can't open $output_filename for writing\n";

629 my $cl;

630 my $in_range=0;

631 for my $i (@Command_Lines_Index) {

632 $cl = $Command_Lines[$i];

634 if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {

635 $in_range=1;

636 next;

637 }

638 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {

639 $in_range=0;

640 next;

641 }

642 next if ($Config{"from"} && $Config{"to"} && !$in_range)

643 ||

644 ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )

645 ||

646 ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)

647 ||

648 ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);

649

650 # Вырезаем из вывода только нужное количество строк

652 my $output="";

654 if (!grep ($_ eq $cl->{"last_command"}, @{$Config{"full_output_commands"}})

655 && ($Config{"head_lines"}

656 || $Config{"tail_lines"})) {

657 # Partialy output

658 my @lines = split '\n', $cl->{"output"};

659 # head

660 my $mark=1;

661 for (my $i=0; $i<= $#lines && $i < $Config{"cache_head_lines"}; $i++) {

662 $output .= $lines[$i]."\n";

663 }

664 # tail

665 my $start=$#lines-$Config{"cache_tail_lines"}+1;

666 if ($start < 0) {

667 $start=0;

668 $mark=0;

669 }

670 if ($start < $Config{"cache_head_lines"}) {

671 $start=$Config{"cache_head_lines"};

672 $mark=0;

673 }

674 $output .= $Config{"skip_text"}."\n" if $mark;

675 for ($i=$start; $i<= $#lines; $i++) {

676 $output .= $lines[$i]."\n";

677 }

678 }

679 else {

680 # Full output

681 $output .= $cl->{"output"};

682 }

684 # Совместимость с labmaker

686 # Переводим в секунды Эпохи

687 # В labmaker'е данные хранились в неудобной форме: hour, min, sec, day of year

688 # Информация о годе отсутствовала

689 # Её можно внести:

690 # Декабрь 2004 год; остальные -- 2005 год.

692 my $year = 2005;

693 #$year = 2004 if ( $cl->{day} > 330 );

694 $year = $Config{year} if $Config{year};

695 # timelocal( $sec, $min, $hour, $mday,$mon,$year);

696 $cl->{time} ||= timelocal_nocheck($cl->{sec},$cl->{min},$cl->{hour},$cl->{day},0,$year);

699 # Начинаем вывод команды

700 print OUT "<command>\n";

701 print OUT "<l3cd>$Config{l3cd}</l3cd>\n" if $Config{"l3cd"};

702 for my $element (qw(

703 local_session_id

704 history

705 uid

706 pid

707 time

708 pwd

709 raw_start

710 raw_output_start

711 raw_end

712 raw_file

713 tty

714 err

715 last_command

716 history

717 )) {

718 next unless defined($cl->{"$element"});

719 print OUT "<$element>".$cl->{$element}."</$element>\n";

720 }

721 for my $element (qw(

722 prompt

723 cline

724 )) {

725 next unless defined($cl->{"$element"});

726 print OUT "<$element>";

727 printq(\*OUT,$cl->{"$element"});

728 print OUT "</$element>\n";

729 }

730 #note

731 #note_title

732 print OUT "<output>";

733 printq(\*OUT,$output);

734 print OUT "</output>\n";

735 if ($cl->{"diff"}) {

736 print OUT "<diff>";

737 printq(\*OUT,${$Diffs{$cl->{"diff"}}}{"text"});

738 print OUT "</diff>\n";

739 }

740 print OUT "</command>\n";

742 }

744 close(OUT);

747 sub print_session

749 my $output_filename = $_[0];

750 my $local_session_id = $_[1];

751 return if not defined($Sessions{$local_session_id});

753 print "printing session info. session id = ".$local_session_id."\n"

754 if $Config{verbose} =~ /y/;

756 open(OUT, ">>", $output_filename)

757 or die "Can't open $output_filename for writing\n";

758 print OUT "<session>\n";

759 print OUT "<l3cd>$Config{l3cd}</l3cd>\n" if $Config{"l3cd"};

760 my %session = %{$Sessions{$local_session_id}};

761 for my $key (keys %session) {

762 print OUT "<$key>".$session{$key}."</$key>\n";

763 print " ".$key,"\n";

764 }

765 print OUT "</session>\n";

766 close(OUT);

769 sub send_cache

771 # Если в кэше что-то накопилось,

772 # попытаемся отправить это на сервер

773 #

774 my $cache_was_sent=0;

775

776 if (open(CACHE, $Config{cache})) {

777 local $/;

778 my $cache = <CACHE>;

779 close(CACHE);

781 my $socket = IO::Socket::INET->new(

782 PeerAddr => $Config{backend_address},

783 PeerPort => $Config{backend_port},

784 proto => "tcp",

785 Type => SOCK_STREAM

786 );

788 if ($socket) {

789 print $socket $cache;

790 close($socket);

791 $cache_was_sent = 1;

792 }

793 }

794 return $cache_was_sent;

797 sub save_cache_stat

799 open (CACHE, ">$Config{cache_stat}");

800 for my $f (keys %Script_Files) {

801 print CACHE "$f\t",$Script_Files{$f}->{size},"\t",$Script_Files{$f}->{tell},"\n";

802 }

803 close(CACHE);

806 sub load_cache_stat

808 if (open (CACHE, "$Config{cache_stat}")) {

809 while(<CACHE>) {

810 chomp;

811 my ($f, $size, $tell) = split /\t/;

812 $Script_Files{$f}->{size} = $size;

813 $Script_Files{$f}->{tell} = $tell;

814 }

815 close(CACHE);

816 };

820 main();

822 sub process_was_killed

824 $Killed = 1;

827 sub reload

829 init_config;

832 sub main

835 $| = 1;

837 init_variables();

838 init_config();

841 if ($Config{"mode"} ne "daemon") {

843 # В нормальном режиме работы нужно

844 # считать скрипты, обработать их и записать

845 # результат выполнения в результирующий файл.

846 # После этого завершить работу.

848 # Очистим кэш-файл, если он существовал

849 if (open (CACHE, ">", $Config{"cache"})) {

850 close(CACHE);

851 };

852 for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) {

853 load_diff_files($lab_log);

854 }

855 load_command_lines($Config{"input"}, $Config{"input_mask"});

856 sort_command_lines;

857 #process_command_lines;

858 print_command_lines($Config{"cache"});

859 }

860 else {

861 if (open(PIDFILE, $Config{agent_pidfile})) {

862 my $pid = <PIDFILE>;

863 close(PIDFILE);

864 if ($^O eq 'linux' && $pid &&(! -e "/proc/$pid" || !`grep $Config{"l3-agent"} /proc/$pid/cmdline && grep "uid:.*\b$<\b" /proc/$pid/status`)) {

865 print "Removing stale pidfile\n";

866 unlink $Config{agent_pidfile}

867 or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!";

868 }

869 elsif ($^O eq 'freebsd' && $pid && `ps axo uid,pid,command | grep '$<\\s*$pid\\s*$Config{"l3-agent"}' 2> /dev/null`) {

870 print "Removing stale pidfile\n";

871 unlink $Config{agent_pidfile}

872 or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!";

873 }

874 elsif ($^O eq 'linux' || $^O eq 'freebsd' ) {

875 print "l3-agent is already running: pid=$pid; pidfile=$Config{agent_pidfile}\n";

876 exit(0);

877 }

878 else {

879 print "Unknown operating system";

880 exit(0);

881 }

882 }

883 if ($Config{detach} =~ /^y/i) {

884 #$Config{verbose} = "no";

885 my $pid = fork;

886 exit if $pid;

887 die "Couldn't fork: $!" unless defined ($pid);

889 open(PIDFILE, ">", $Config{agent_pidfile})

890 or die "Can't open pidfile ". $Config{agent_pidfile}. " for wrting: $!";

891 print PIDFILE $$;

892 close(PIDFILE);

894 for my $handle (*STDIN, *STDOUT, *STDERR) {

895 open ($handle, "+<", "/dev/null")

896 or die "can't reopen $handle to /dev/null: $!"

897 }

899 POSIX::setsid()

900 or die "Can't start a new session: $!";

902 $0 = $Config{"l3-agent"};

903

904 $SIG{INT} = $SIG{TERM} = \&process_was_killed;

905 $SIG{HUP} = \&reload;

907 }

908 while (not $Killed) {

909 @Command_Lines = ();

910 @Command_Lines_Index = ();

911 for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) {

912 load_diff_files($lab_log);

913 }

914 load_cache_stat();

915 load_command_lines($Config{"input"}, $Config{"input_mask"});

916 if (@Command_Lines) {

917 sort_command_lines;

918 #process_command_lines;

919 print_command_lines($Config{"cache"});

920 }

921 save_cache_stat();

922 if (-e $Config{cache} && (stat($Config{cache}))[7]) {

923 send_cache() && unlink($Config{cache});

924 }

925 sleep($Config{"daemon_sleep_interval"} || 1);

926 }

927

928 unlink $Config{agent_pidfile};

929 }

933 sub init_variables