lilalo: d28dda8ea18f l3-agent

lilalo

view l3-agent @ 80:d28dda8ea18f

1)
Изменён формат имени diff-файлов.
Теперь в имени присутствует только название сессии, время и имя файла.

2)
Можно просмотреть отдельную сессию.
Для этого нужно щёлкнуть по блоку сессии в журнале

3)
Исправлена ошибка с таблицей новых команд в последнем дне.
Раньше она просто не показывалась

4)
Запись lablog-ов теперь ведётся только для интерактивных shell'ов
Неинтерактивные работают как обычно.

author	devi
date	Mon Feb 20 17:52:40 2006 +0200 (2006-02-20)
parents	a10db759e587
children	d9a700d48bef

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"}));

130 print "diff of my session found\n";

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

134 my $dt;

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

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

137 }

138 else {

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

140 }

141 if ($dt >0

142 && $dt < $min_dt

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

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

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

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

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

148 };

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

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

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

153 $min_dt = $dt;

154 }

155 }

159 sub extract_commands_from_cline

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

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

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

164 my $cline = $_[0];

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

166

167

168 my @commands = ();

169 for my $list (@lists) {

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

171 }

173 my %commands;

174 my %files;

175 my $i=0;

176 for my $command (@commands) {

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

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

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

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

181 }

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

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

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

185 };

186 }

187 return %commands;

190 sub load_command_lines

192 my $lab_scripts_path = $_[0];

193 my $lab_scripts_mask = $_[1];

195 my $cline_re_base = qq'

196 (

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

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

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

200 (...?) # day

201 (.?.?) # lab

202 \\s # space separator

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

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

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

206 (.*) # command line

207 )

208 ';

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

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

212 my $cline_re_v2_base = qq'

213 (

214 v2[\#] # version

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

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

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

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

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

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

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

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

223 (.*) # command line

224 )

225 ';

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

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

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

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

232 my $cline_vt = Term::VT102->new ('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 }

284 open (FILE, "$file");

285 binmode FILE;

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

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

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

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

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

294 print "\n+- processing file $file\n" if $Config{"verbose"} =~/y/;

296 my $tty = $1;

297 my $first_pass = 1;

298 my %cl;

299 my $last_output_length=0;

300 while (<FILE>) {

301 $commandlines_processed++;

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

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

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

307 m/$cline_re2/gs;

309 $commandlines_loaded++;

310 $last_output_length=0;

312 # Previous command

313 my %last_cl = %cl;

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

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

317 # Parse new command

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

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

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

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

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

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

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

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

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

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

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

330 {

331 use bytes;

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

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

334 }

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

337 $cl{"err"} = 0;

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

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

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

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

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

344 $cline_vt->reset();

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

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

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

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

351 if (

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

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

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

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

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

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

358 ) {

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

360 }

361 else {

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

363 }

364 $skip_info = 0;

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

369 # Processing previous command line

370 if ($first_pass) {

371 $first_pass = 0;

372 next;

373 }

375 # Error code

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

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

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

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

381 bind_diff(\%last_cl);

382 }

384 # Output

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

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

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

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

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

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

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

392 }

393 }

394 else {

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

396 }

398 $vt->reset();

401 # Save

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

403 # Changing encoding

404 for (keys %last_cl) {

405 next if /raw/;

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

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

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

409 }

410 push @Command_Lines, \%last_cl;

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

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

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

415 }

416 next;

417 }

420 elsif (m/$cline_re_v2/) {

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

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

427 m/$cline_re2_v2/gs;

429 $commandlines_loaded++;

430 $last_output_length=0;

432 # Previous command

433 my %last_cl = %cl;

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

436 # Parse new command

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

438 my $err = $3;

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

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

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

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

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

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

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

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

448 {

449 use bytes;

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

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

452 }

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

455 $cl{"err"} = 0;

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

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

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

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

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

462 $cline_vt->reset();

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

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

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

467 $cl{"last_command"}

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

470 if (

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

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

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

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

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

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

477 ) {

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

479 }

480 else {

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

482 }

483 $skip_info = 0;

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

487 print "| " if $commandlines_loaded % 15 == 1;

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

489 }

491 # Processing previous command line

492 if ($first_pass) {

493 $first_pass = 0;

494 next;

495 }

497 # Error code

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

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

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

502 bind_diff(\%last_cl);

503 }

505 # Output

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

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

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

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

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

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

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

513 }

514 }

515 else {

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

517 }

519 $vt->reset();

522 # Changing encoding

523 for (keys %last_cl) {

524 next if /raw/;

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

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

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

528 }

529 }

530 push @Command_Lines, \%last_cl;

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

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

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

536 next;

538 }

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

542 $last_output_length+=length($_);

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

544 if ($last_output_length < 50000) {

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

546 }

547 else

548 {

549 if (!$skip_info) {

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

551 $skip_info = 1;

552 }

553 }

554 }

555 close(FILE);

557 }

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

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

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

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

562 }

568 sub sort_command_lines

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

572 # Sort Command_Lines

573 # Write Command_Lines to Command_Lines_Index

575 my @index;

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

577 $index[$i]=$i;

578 }

580 @Command_Lines_Index = sort {

581 $Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"} ||

582 $Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"} ||

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

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

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

586 } @index;

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

592 sub printq

594 my $TO = shift;

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

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

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

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

599 print $TO $text;

603 =cut

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

605 =cut

607 sub print_command_lines

609 my $output_filename=$_[0];

610 my $mode = ">";

611 $mode =">>" if $Config{mode} eq "daemon";

612 open(OUT, $mode, $output_filename)

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

616 my $cl;

617 my $in_range=0;

618 for my $i (@Command_Lines_Index) {

619 $cl = $Command_Lines[$i];

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

622 $in_range=1;

623 next;

624 }

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

626 $in_range=0;

627 next;

628 }

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

630 ||

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

632 ||

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

634 ||

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

636

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

639 my $output="";

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

642 && ($Config{"head_lines"}

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

644 # Partialy output

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

646 # head

647 my $mark=1;

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

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

650 }

651 # tail

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

653 if ($start < 0) {

654 $start=0;

655 $mark=0;

656 }

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

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

659 $mark=0;

660 }

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

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

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

664 }

665 }

666 else {

667 # Full output

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

669 }

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

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

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

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

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

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

679 my $year = 2005;

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

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

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

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

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

687 print OUT "<command>\n";

688 for my $element (qw(

689 local_session_id

690 history

691 uid

692 pid

693 time

694 pwd

695 raw_start

696 raw_output_start

697 raw_end

698 raw_file

699 tty

700 err

701 last_command

702 history

703 )) {

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

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

706 }

707 for my $element (qw(

708 prompt

709 cline

710 )) {

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

712 print OUT "<$element>";

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

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

715 }

716 #note

717 #note_title

718 print OUT "<output>";

719 printq(\*OUT,$output);

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

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

722 print OUT "<diff>";

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

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

725 }

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

728 }

730 close(OUT);

733 sub print_session

735 my $output_filename = $_[0];

736 my $local_session_id = $_[1];

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

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

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

741 print OUT "<session>\n";

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

743 for my $key (keys %session) {

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

745 }

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

747 close(OUT);

750 sub send_cache

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

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

754 #

755 my $cache_was_sent=0;

756

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

758 local $/;

759 my $cache = <CACHE>;

760 close(CACHE);

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

763 PeerAddr => $Config{backend_address},

764 PeerPort => $Config{backend_port},

765 proto => "tcp",

766 Type => SOCK_STREAM

767 );

769 if ($socket) {

770 print $socket $cache;

771 close($socket);

772 $cache_was_sent = 1;

773 }

774 }

775 return $cache_was_sent;

778 sub save_cache_stat

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

781 for my $f (keys %Script_Files) {

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

783 }

784 close(CACHE);

787 sub load_cache_stat

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

790 while(<CACHE>) {

791 chomp;

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

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

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

795 }

796 close(CACHE);

797 };

801 main();

803 sub process_was_killed

805 $Killed = 1;

808 sub main

811 $| = 1;

813 init_variables();

814 init_config();

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

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

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

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

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

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

825 load_diff_files($lab_log);

826 }

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

828 sort_command_lines;

829 #process_command_lines;

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

831 }

832 else {

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

834 my $pid = <PIDFILE>;

835 close(PIDFILE);

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

837 print "Removing stale pidfile\n";

838 unlink $Config{agent_pidfile}

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

840 }

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

842 print "Removing stale pidfile\n";

843 unlink $Config{agent_pidfile}

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

845 }

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

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

848 exit(0);

849 }

850 else {

851 print "Unknown operating system";

852 exit(0);

853 }

854 }

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

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

857 my $pid = fork;

858 exit if $pid;

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

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

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

863 print PIDFILE $$;

864 close(PIDFILE);

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

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

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

869 }

871 POSIX::setsid()

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

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

875

876 $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&process_was_killed;

877 }

878 while (not $Killed) {

879 @Command_Lines = ();

880 @Command_Lines_Index = ();

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

882 load_diff_files($lab_log);

883 }

884 load_cache_stat();

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

886 if (@Command_Lines) {

887 sort_command_lines;

888 #process_command_lines;

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

890 }

891 save_cache_stat();

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

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

894 }

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

896 }

897

898 unlink $Config{agent_pidfile};

899 }

903 sub init_variables