lilalo: 43aeb3036aaa l3-agent

lilalo

view l3-agent @ 56:43aeb3036aaa

l3-frontend:

Наведение порядка в коде. Пока что, он ещё достаточно сырой
и некрасивый, но это всё же лучше, чем то, что было раньше.
Добавлено:
* команды, набранные с ошибками показываются зачёркнутым текстом
* в статистике подсвечиваются известные/неизвестные команды,
как раньше по тексту
* в названиях программ/скриптов пути, содержащие /etc, не отрезаются

l3-agent:
Неправильно передавался код завершения. Fixed
Код откровенно мерзкий и требует доработок

author	devi
date	Wed Dec 28 01:01:00 2005 +0200 (2005-12-28)
parents	eab4f7df854c
children	187b6636a3be

line source

1 #!/usr/bin/perl -w

4 # (c) Igor Chubin, imchubin@mail.ru, 2004-2005

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 %Commands_Stat; # Statistics about commands usage

28 our %Files_Stat; # Statistics about commands usage

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

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

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

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

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

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

38 sub init_variables;

39 sub main;

41 sub load_diff_files;

42 sub bind_diff;

43 sub extract_from_cline;

44 sub load_command_lines;

45 sub sort_command_lines;

46 sub process_command_lines;

47 sub print_command_lines;

48 sub printq;

50 sub save_cache_stat;

51 sub load_cache_stat;

52 sub print_session;

54 sub load_diff_files

56 my @pathes = @_;

58 for my $path (@pathes) {

59 my $template = "*.diff";

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

61 my $i=0;

62 for my $file (@files) {

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

66 my %diff;

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

69 $diff{"uid"}="SET THIS";

71 # Сейчас UID определяется из названия каталога

72 # откуда берутся diff-файлы

73 # Это неправильно

75 # ВАРИАНТ:

76 # К файлам жураналам должны прилагаться ситемны файлы,

77 # мз которых и будет определяться соответствие

78 # имён пользователей их uid'ам

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

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

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

85 next if not $file=~m@/(D?[0-9][0-9]?[0-9]?)[^/]*?([0-9]*):([0-9]*):?([0-9]*)@;

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

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

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

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

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

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

95 local $/;

96 open (F, "$file")

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

98 my $text = <F>;

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

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

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

102 }

103 close(F);

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

105 #print "$file loaded ($diff{day})\n";

107 #push @Diffs, \%diff;

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

109 $i++;

115 sub bind_diff

117 # my $path = shift;

118 # my $pid = shift;

119 # my $day = shift;

120 # my $lab = shift;

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

124 my $cl = shift;

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

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

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

129 my $min_dt = 10000;

131 for my $diff_key (keys %Diffs) {

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

133 # Check here date, time and user

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

135 #next if (!$diff->{"uid"} && $cl->{"euid"} != $diff->{"uid"});

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

138 if ($dt >0 && $dt < $min_dt && ($diff->{"time_range"} <0 || $dt < $diff->{"time_range"})) {

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

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

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

142 };

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

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

146 #$cl->{"diff"} = $diff->{"index"};

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

148 $min_dt = $dt;

149 }

155 sub extract_from_cline

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

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

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

160 my $what = $_[0];

161 my $cline = $_[1];

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

165 my @commands = ();

166 for my $list (@lists) {

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

170 my %commands;

171 my %files;

172 my $i=0;

173 for my $command (@commands) {

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

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

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

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

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

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

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

182 };

183 if ($2) {

184 my $args = $2;

185 my @args = split (/\s+/, $args);

186 for my $a (@args) {

187 $files{"$a"}=$i++

188 if !defined $files{"$a"};

189 };

191

195 if ($what eq "commands") {

196 return %commands;

197 } else {

198 return %files;

203 sub load_command_lines

205 my $lab_scripts_path = $_[0];

206 my $lab_scripts_mask = $_[1];

208 my $cline_re_base = qq'

209 (

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

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

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

213 (...?) # day

214 (.?.?) # lab

215 \\s # space separator

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

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

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

219 (.*) # command line

220 )

221 ';

222 #my $cline_re = qr/$cline_re_base(?:$cline_re_base|$)/x;

223 #my $cline_re = qr/(?:$cline_re_base)*$cline_re_base$/x;

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

225 my $cline_re1 = qr/$cline_re_base\x0D/sx;

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

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

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

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

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

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

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

236 print "Loading lm-scripts...\n" if $Config{"verbose"} =~ /y/;

238 my $file;

239 my $skip_info;

241 my $commandlines_loaded =0;

242 my $commandlines_processed =0;

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

245 for $file (@lab_scripts){

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

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

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

252 my $local_session_id;

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

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

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

256 $local_session_id = $1;

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

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

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

261 my $session_file = $file;

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

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

264 local $/;

265 my $data = <SESSION>;

266 close(SESSION);

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

269 my %session;

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

271 $session{$1} = $2;

272 }

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

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

275 }

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

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

279 }

282 open (FILE, "$file");

283 binmode FILE;

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

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

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

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

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

293 my $tty = $1;

294 my $first_pass = 1;

295 my %cl;

296 my $last_output_length=0;

297 while (<FILE>) {

299 $commandlines_processed++;

300 # time

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

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

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

306 # print "!!!",$_,"!!!\n";

307 # next;

308 # while (m/$cline_re1/gs) {

309 # }

310 m/$cline_re2/gs;

312 $commandlines_loaded++;

313 $last_output_length=0;

315 # Previous command

316 my %last_cl = %cl;

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

320 =cut

322 Атрибуты cline

323 Список полей, характеризующих командную строку

325 uid

326 Идентификатор пользователя

328 tty

329 Идентификатор терминала, на котором была вызвана команда

331 pid

332 PID-процесса командного интерпретатора,

333 в котором была вызвана команда

335 lab

336 лабораторная работа, к которой относится команда.

337 Идентификатор текущей лабораторной работы

338 хранится в файле ~/.labmaker/lab

340 pwd (!)

341 текущий каталог, из которого была вызвана команда

343 day

344 время вызова, день

345 В действительности здесь хранится не время вызова команды,

346 а с момента появления приглашения командного интерпретатора

347 для ввода команды

350 hour

351 время вызова, час

353 min

354 время вызова, минута

356 sec

357 время вызова, секунда

359 time (!)

360 время вызова команды в Unix-формате.

361 Предпочтительнее использовать этот формат чем hour:min:sec,

362 использовавшийся в Labmaker

364 fullprompt

365 Приглашение командной строки

367 prompt

368 Сокращённое приглашение командной строки

370 cline

371 Командная строка

373 output

374 Результат выполнения команды

376 diff

377 Указатель на ассоциированный с командой diff

379 note (!)

380 Текстовый комментарий к команде.

381 Может генерироваться из самого лога с помощью команд

382 #^ Комментарий

383 #= Комментарий

384 #v Комментарий

385 в том случае, если для комментирования достаточно одной строки,

386 или с помощью команд

387 cat > /dev/null #^ Заголовок

388 Текст

389 ^D

390 в том случае, если комментарий развёрнутый.

391 В последнем случае комментарий может содержать

392 заголовок, абзацы и несложное форматирование.

394 Символы ^, v или = после знака комментария # обозначает,

395 к какой команде относится комментарий:

396 к предыдущей (^), последующей (v)

397 или это общий комментарий по тексту, не относящийся непосредственно

398 ни к одной из них (=)

400 err

401 Код завершения командной строки

403 histnum (!)

404 Номер команды в истории командного интерпретатора

406 status (!)

407 Является ли данная команда вызванной (r), запомненной (s)

408 или это подсказка completion (c).

410 Команды, которые были вызваны и обработаны интерпретатором

411 имеют состояние "r". К таким командам относится большинство

412 команд вводимых в интерпретатор.

414 Если команда набрана, но вызывать её по какой-либо причине

415 не хочется (например, команда может быть не полной, вредоносной

416 или просто бессмысленной в текущих условиях),

417 её можно сбросить с помощью комбинации клавиш Ctrl-C

418 (не путайте с прерыванием работающей команды! здесь она даже

419 не запускается!).

420 В таком случае она не выполняется, но попадает в журнал

421 со статусом "s".

423 Если команда появилась в журнале благодаря автопроолжению

424 -- когда было показано несколько вариантов --

425 она имеет статус "c".

427 euid

428 Идентификатор пользователя от имени которого будет

429 выполняться команда.

430 Может отличаться от реального uid в том случае,

431 если вызывается с помощью sudo

434 version (!)

435 Версия lilalo-prompt использовавшаяся при записи

436 команды.

438 0 - версия использовавшая в labmaker.

439 Отсутствует информация о текущем каталоге и номере в истории.

440 Информация о версии также не указана в приглашении.

443 1 - версия использующаяся в lilalo

445 raw_file

446 Имя файла, в котором находится бинарное представление журнала.

447 Может содержать ключевое слово HERE,

448 обозначающее что бинарное представление хранится

449 непосредственно в базе данных в атрибуте raw_data

451 raw_start

452 Начало блока командной строки в файле бинарного представления

454 raw_output_start

455 Начало блока вывода

457 raw_end

458 Конец блока командной строки в файле бинарного представления

460 raw_cline

461 Необработанная командная строка (без приглашения) в бинарном виде

463 raw_data (*)

464 Бинарное представление команды и результатов её выполнения

469 ТАБЛИЦА SESSION

471 Информация о сеансах

473 (см. lm-install)

476 =cut

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

479 # Parse new command

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

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

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

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

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

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

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

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

488 $cl{"fullprompt"} = $10;

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

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

492 {

493 use bytes;

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

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

496 }

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

499 $cl{"err"} = 0;

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

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

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

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

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

506 $cline_vt->reset();

508 my %commands = extract_from_cline("commands", $cl{"cline"});

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

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

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

513 if (

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

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

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

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

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

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

520 ) {

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

522 }

523 else {

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

525

526 }

527 $skip_info = 0;

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

532 # Processing previous command line

533 if ($first_pass) {

534 $first_pass = 0;

535 next;

536 }

538 # Error code

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

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

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

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

544 bind_diff(\%last_cl);

545 }

547 # Output

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

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

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

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

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

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

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

555 }

556 }

557 else {

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

559 }

561 $vt->reset();

564 # Classifying the command line

567 # Save

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

569 # Changing encoding

570 for (keys %last_cl) {

571 next if /raw/;

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

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

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

575 }

576 push @Command_Lines, \%last_cl;

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

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

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

581 }

582 next;

583 }

584 $last_output_length+=length($_);

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

586 if ($last_output_length < 50000) {

587 #print "(",length($_),")" if (length($_) > 2000) ;

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

589 }

590 else

591 {

592 if (!$skip_info) {

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

594 $skip_info = 1;

595 }

596 }

597 }

598 close(FILE);

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

602 print "...finished." ;

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

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

610 sub printq

612 my $TO = shift;

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

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

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

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

617 print $TO $text;

621 sub sort_command_lines

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

625 # Sort Command_Lines

626 # Write Command_Lines to Command_Lines_Index

628 my @index;

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

630 $index[$i]=$i;

633 @Command_Lines_Index = sort {

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

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

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

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

638 } @index;

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

644 sub process_command_lines

646 for my $i (@Command_Lines_Index) {

648 my $cl = \$Command_Lines[$i];

649 @{${$cl}->{"new_commands"}} =();

650 @{${$cl}->{"new_files"}} =();

651 $$cl->{"class"} = "";

653 if ($$cl->{"err"}) {

654 $$cl->{"class"}="wrong";

655 $$cl->{"class"}="interrupted"

656 if ($$cl->{"err"} eq 130);

657 }

658 if (!$$cl->{"euid"}) {

659 $$cl->{"class"}.="_root";

662 #tab# my @tab_words=split /\s+/, $$cl->{"output"};

663 #tab# my $last_word= $$cl->{"cline"} =~ /(\S*)$/;

664 #tab# $last_word =~ s@.*/@@;

665 #tab# my $this_is_tab=1;

666 #tab#

667 #tab# if ($last_word && @tab_words >2) {

668 #tab# for my $tab_words (@tab_words) {

669 #tab# if ($tab_words !~ /^$last_word/) {

670 #tab# $this_is_tab=0;

671 #tab# last;

672 #tab# }

673 #tab# }

674 #tab# }

675 #tab# $$cl->{"class"}="tab" if $this_is_tab;

678 if ( !$$cl->{"err"}) {

679 # Command does not contain mistakes

681 my %commands = extract_from_cline("commands", ${$cl}->{"cline"});

682 my %files = extract_from_cline("files", ${$cl}->{"cline"});

684 # Searching for new commands only

685 for my $command (keys %commands) {

686 if (!defined $Commands_Stat{$command}) {

687 push @{$$cl->{new_commands}}, $command;

688 }

689 $Commands_Stat{$command}++;

690 }

692 for my $file (keys %files) {

693 if (!defined $Files_Stat{$file}) {

694 push @{$$cl->{new_files}}, $file;

695 }

696 $Files_Stat{$file}++;

697 }

698 }

700 #if ($$cl->{cline}=~ /#\^(.*)/) {

701 # my $j=$i-1;

702 # $j-- while ($j >=0 && $Command_Lines[$j]->{tty} ne $$cl->{tty});

703 # $Command_Lines[$j]->{note_title}="Замечание";

704 # $Command_Lines[$j]->{note}="$1";

705 #}

711 =cut

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

713 =cut

716 sub print_command_lines

718 my $output_filename=$_[0];

719 my $mode = ">";

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

721 open(OUT, $mode, $output_filename)

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

726 #print OUT "<livelablog>\n";

728 my $cl;

729 my $in_range=0;

730 for my $i (@Command_Lines_Index) {

731 $cl = $Command_Lines[$i];

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

734 $in_range=1;

735 next;

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

738 $in_range=0;

739 next;

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

742 ||

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

744 ||

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

746 ||

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

749 my @new_commands=@{$cl->{"new_commands"}};

750 my @new_files=@{$cl->{"new_files"}};

752 my $cl_class="cline";

753 my $out_class="output";

754 if ($cl->{"class"}) {

755 $cl_class = $cl->{"class"}."_".$cl_class;

756 $out_class = $cl->{"class"}."_".$out_class;

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

761 my $output="";

762 if ($Config{"head_lines"} || $Config{"tail_lines"}) {

763 # Partialy output

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

765 # head

766 my $mark=1;

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

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

769 }

770 # tail

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

772 if ($start < 0) {

773 $start=0;

774 $mark=0;

775 }

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

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

778 $mark=0;

779 }

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

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

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

783 }

784 }

785 else {

786 # Full output

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

788 }

789 #$output .= "^C\n" if ($cl->{"err"} eq "130");

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

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

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

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

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

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

800 my $year = 2005;

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

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

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

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

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

808 print OUT "<command>\n";

809 print OUT "<local_session_id>",$cl->{local_session_id},"</local_session_id>\n";

810 print OUT "<time>",$cl->{time},"</time>\n";

811 print OUT "<raw_start>",$cl->{raw_start},"</raw_start>\n";

812 print OUT "<raw_output_start>",$cl->{raw_output_start},"</raw_output_start>\n";

813 print OUT "<raw_end>",$cl->{raw_end},"</raw_end>\n";

814 print OUT "<raw_file>",$cl->{raw_file},"</raw_file>\n";

815 print OUT "<tty>",$cl->{tty},"</tty>\n";

816 print OUT "<out_class>",$out_class,"</out_class>\n";

817 print OUT "<err>",$cl->{err},"</err>\n";

818 print OUT "<prompt>";

819 printq(\*OUT,,$cl->{"prompt"});

820 print OUT "</prompt>";

821 print OUT "<cline>";

822 printq(\*OUT,$cl->{"cline"});

823 print OUT "</cline>\n";

824 print OUT "<last_command>",$cl->{"last_command"},"</last_command>\n";

825 if (@new_commands) {

826 print OUT "<new_commands>";

827 printq(\*OUT, join (" ", @new_commands));

828 print OUT "</new_commands>";

830 if (@new_files) {

831 print OUT "<new_files>";

832 printq(\*OUT, join (" ", @new_files));

833 print OUT "</new_files>";

835 print OUT "<output>";

836 printq(\*OUT,$output);

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

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

839 print OUT "<diff>";

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

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

843 if ($cl->{"note"}) {

844 print OUT "<note>";

845 printq(\*OUT,$cl->{"note"});

846 print OUT "</note>\n";

848 if ($cl->{"note_title"}) {

849 print OUT "<note_title>";

850 printq(\*OUT,$cl->{"note_title"});

851 print OUT "</note_title>\n";

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

857 #print OUT "</livelablog>\n";

858 close(OUT);

861 sub print_session

863 my $output_filename = $_[0];

864 my $local_session_id = $_[1];

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

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

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

869 print OUT "<session>\n";

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

871 for my $key (keys %session) {

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

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

875 close(OUT);

878 sub send_cache

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

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

883 my $cache_was_sent=0;

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

886 local $/;

887 my $cache = <CACHE>;

888 close(CACHE);

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

891 PeerAddr => $Config{backend_address},

892 PeerPort => $Config{backend_port},

893 proto => "tcp",

894 Type => SOCK_STREAM

895 );

897 if ($socket) {

898 print $socket $cache;

899 close($socket);

900 $cache_was_sent = 1;

903 return $cache_was_sent;

906 sub save_cache_stat

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

909 for my $f (keys %Script_Files) {

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

912 close(CACHE);

915 sub load_cache_stat

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

918 while(<CACHE>) {

919 chomp;

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

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

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

924 close(CACHE);

929 main();

931 sub process_was_killed

933 $Killed = 1;

936 sub main

939 $| = 1;

941 init_variables();

942 init_config();

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

947 =cut

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

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

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

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

952 =cut

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

954 load_diff_files($lab_log);

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

957 sort_command_lines;

958 process_command_lines;

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

961 else {

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

963 my $pid = <PIDFILE>;

964 close(PIDFILE);

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

966 print "Removing stale pidfile\n";

967 unlink $Config{agent_pidfile}

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

969 }

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

971 print "Removing stale pidfile\n";

972 unlink $Config{agent_pidfile}

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

974 }

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

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

977 exit(0);

978 }

979 else {

980 print "Unknown operating system";

981 exit(0);

982 }

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

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

986 my $pid = fork;

987 exit if $pid;

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

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

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

992 print PIDFILE $$;

993 close(PIDFILE);

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

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

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

998 }

1000 POSIX::setsid()

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

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

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

1007 while (not $Killed) {

1008 @Command_Lines = ();

1009 @Command_Lines_Index = ();

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

1011 load_diff_files($lab_log);

1012 }

1013 load_cache_stat();

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

1015 if (@Command_Lines) {

1016 sort_command_lines;

1017 process_command_lines;

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

1019 }

1020 save_cache_stat();

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

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

1023 }

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

1027 unlink $Config{agent_pidfile};

1032 sub init_variables