lilalo: f5f07049bd4f l3-agent

lilalo

view l3-agent @ 30:f5f07049bd4f

l3-agent:
Исправлен баг с инициализацией session_id

l3-cgi:
* Добавлена поддержка index-страницы.
При обращении на /cgi-bin/l3/index показывается таблица
с ссылками на журналы всех тренингов
В самом журнале корректно показывается информация
о курсе.

* Поскольку термин "class" перегружен, вместо него теперь
используется термин "training".
В дальнейшем такая замена произойдёт во всём коде.

* Теперь l3-cgi использует конфигурационный модуль l3config.pm
Загрузка выполняется с помощью require на этапе исполнения

l3config.pm:
Перенесены конфигурационные параметры lm.
ОСТОРОЖНО! Сам lm ПОКА ЧТО не использует l3config.pm для конфигурирования.

author	devi
date	Tue Nov 08 12:16:20 2005 +0200 (2005-11-08)
parents	450b6ac9b657
children	196c82b6e538

line source

1 #!/usr/bin/perl -w

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

7 use strict;

8 use POSIX;

9 use Term::VT102;

10 use Text::Iconv;

11 use Data::Dumper;

12 use Time::Local 'timelocal_nocheck';

13 use IO::Socket;

15 use lib ".";

16 use l3config;

19 our @Command_Lines;

20 our @Command_Lines_Index;

21 our %Diffs;

22 our %Sessions;

24 our %Commands_Stat; # Statistics about commands usage

25 our %Files_Stat; # Statistics about commands usage

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_from_cline;

41 sub load_command_lines;

42 sub sort_command_lines;

43 sub process_command_lines;

44 sub print_command_lines;

45 sub printq;

47 sub save_cache_stat;

48 sub load_cache_stat;

49 sub print_session;

51 sub load_diff_files

53 my @pathes = @_;

55 for my $path (@pathes) {

56 my $template = "*.diff";

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

58 my $i=0;

59 for my $file (@files) {

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

63 my %diff;

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

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

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

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

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

72 # ВАРИАНТ:

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

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

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

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

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

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

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

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

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

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

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

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

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

92 local $/;

93 open (F, "$file")

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

95 my $text = <F>;

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

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

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

99 }

100 close(F);

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

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

104 #push @Diffs, \%diff;

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

106 $i++;

112 sub bind_diff

114 # my $path = shift;

115 # my $pid = shift;

116 # my $day = shift;

117 # my $lab = shift;

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

121 my $cl = shift;

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

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

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

126 my $min_dt = 10000;

128 for my $diff_key (keys %Diffs) {

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

130 # Check here date, time and user

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

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

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

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

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

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

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

139 };

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

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

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

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

145 $min_dt = $dt;

146 }

152 sub extract_from_cline

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

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

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

157 my $what = $_[0];

158 my $cline = $_[1];

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

162 my @commands = ();

163 for my $list (@lists) {

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

167 my %commands;

168 my %files;

169 my $i=0;

170 for my $command (@commands) {

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

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

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

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

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

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

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

179 };

180 if ($2) {

181 my $args = $2;

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

183 for my $a (@args) {

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

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

186 };

188

192 if ($what eq "commands") {

193 return %commands;

194 } else {

195 return %files;

200 sub load_command_lines

202 my $lab_scripts_path = $_[0];

203 my $lab_scripts_mask = $_[1];

205 my $cline_re_base = qq'

206 (

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

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

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

210 (...?) # day

211 (.?.?) # lab

212 \\s # space separator

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

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

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

216 (.*) # command line

217 )

218 ';

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

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

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

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

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

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

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

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

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

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

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

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

235 my $file;

236 my $skip_info;

238 my $commandlines_loaded =0;

239 my $commandlines_processed =0;

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

242 for $file (@lab_scripts){

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

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

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

249 my $local_session_id;

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

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

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

253 $local_session_id = $1;

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

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

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

258 my $session_file = $file;

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

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

261 local $/;

262 my $data = <SESSION>;

263 close(SESSION);

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

266 my %session;

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

268 $session{$1} = $2;

269 }

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

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

272 }

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

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

276 }

279 open (FILE, "$file");

280 binmode FILE;

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

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

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

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

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

290 my $tty = $1;

291 my $first_pass = 1;

292 my %cl;

293 my $last_output_length=0;

294 while (<FILE>) {

296 $commandlines_processed++;

297 # time

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

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

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

302 # next;

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

304 # }

305 m/$cline_re2/gs;

307 $commandlines_loaded++;

308 $last_output_length=0;

310 # Previous command

311 my %last_cl = %cl;

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

315 =cut

317 Атрибуты cline

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

320 uid

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

323 tty

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

326 pid

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

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

330 lab

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

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

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

335 pwd (!)

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

338 day

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

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

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

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

345 hour

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

348 min

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

351 sec

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

354 time (!)

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

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

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

359 fullprompt

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

362 prompt

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

365 cline

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

368 output

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

371 diff

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

374 note (!)

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

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

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

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

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

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

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

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

383 Текст

384 ^D

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

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

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

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

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

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

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

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

395 err

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

398 histnum (!)

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

401 status (!)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

422 euid

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

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

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

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

429 version (!)

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

431 команды.

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

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

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

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

440 raw_file

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

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

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

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

446 raw_start

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

449 raw_output_start

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

452 raw_end

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

455 raw_cline

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

458 raw_data (*)

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

464 ТАБЛИЦА SESSION

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

468 (см. lm-install)

471 =cut

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

474 # Parse new command

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

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

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

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

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

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

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

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

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

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

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

487 {

488 use bytes;

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

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

491 }

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

494 $cl{"err"} = 0;

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

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

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

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

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

501 $cline_vt->reset();

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

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

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

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

508 if (

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

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

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

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

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

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

515 ) {

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

517 }

518 else {

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

520

521 }

522 $skip_info = 0;

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

527 # Processing previous command line

528 if ($first_pass) {

529 $first_pass = 0;

530 next;

531 }

533 # Error code

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

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

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

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

539 bind_diff(\%last_cl);

540 }

542 # Output

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

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

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

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

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

548 $last_cl{"output"} .= $line."\n";

549 }

550 }

551 else {

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

553 }

555 $vt->reset();

558 # Classifying the command line

561 # Save

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

563 # Changing encoding

564 for (keys %last_cl) {

565 next if /raw/;

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

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

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

569 }

570 push @Command_Lines, \%last_cl;

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

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

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

575 }

576 next;

577 }

578 $last_output_length+=length($_);

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

580 if ($last_output_length < 50000) {

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

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

583 }

584 else

585 {

586 if (!$skip_info) {

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

588 $skip_info = 1;

589 }

590 }

591 }

592 close(FILE);

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

596 print "...finished." ;

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

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

604 sub printq

606 my $TO = shift;

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

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

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

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

611 print $TO $text;

615 sub sort_command_lines

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

619 # Sort Command_Lines

620 # Write Command_Lines to Command_Lines_Index

622 my @index;

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

624 $index[$i]=$i;

627 @Command_Lines_Index = sort {

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

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

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

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

632 } @index;

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

638 sub process_command_lines

640 for my $i (@Command_Lines_Index) {

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

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

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

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

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

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

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

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

651 }

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

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

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

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

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

659 #tab# my $this_is_tab=1;

660 #tab#

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

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

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

664 #tab# $this_is_tab=0;

665 #tab# last;

666 #tab# }

667 #tab# }

668 #tab# }

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

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

673 # Command does not contain mistakes

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

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

678 # Searching for new commands only

679 for my $command (keys %commands) {

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

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

682 }

683 $Commands_Stat{$command}++;

684 }

686 for my $file (keys %files) {

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

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

689 }

690 $Files_Stat{$file}++;

691 }

692 }

698 =cut

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

700 =cut

703 sub print_command_lines

705 my $output_filename=$_[0];

706 my $mode = ">";

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

708 open(OUT, $mode, $output_filename)

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

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

715 my $cl;

716 my $in_range=0;

717 for my $i (@Command_Lines_Index) {

718 $cl = $Command_Lines[$i];

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

721 $in_range=1;

722 next;

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

725 $in_range=0;

726 next;

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

729 ||

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

731 ||

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

733 ||

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

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

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

739 my $cl_class="cline";

740 my $out_class="output";

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

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

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

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

748 my $output="";

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

750 # Partialy output

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

752 # head

753 my $mark=1;

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

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

756 }

757 # tail

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

759 if ($start < 0) {

760 $start=0;

761 $mark=0;

762 }

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

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

765 $mark=0;

766 }

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

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

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

770 }

771 }

772 else {

773 # Full output

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

775 }

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

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

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

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

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

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

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

787 my $year = 2005;

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

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

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

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

794 print OUT "<command>\n";

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

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

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

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

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

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

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

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

803 print OUT "<prompt>";

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

805 print OUT "</prompt>";

806 print OUT "<cline>";

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

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

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

810 if (@new_commands) {

811 print OUT "<new_commands>";

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

813 print OUT "</new_commands>";

815 if (@new_files) {

816 print OUT "<new_files>";

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

818 print OUT "</new_files>";

820 print OUT "<output>";

821 printq(\*OUT,$output);

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

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

824 print OUT "<diff>";

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

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

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

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

833 close(OUT);

836 sub print_session

838 my $output_filename = $_[0];

839 my $local_session_id = $_[1];

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

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

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

844 print OUT "<session>\n";

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

846 for my $key (keys %session) {

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

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

850 close(OUT);

853 sub send_cache

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

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

858 my $cache_was_sent=0;

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

861 local $/;

862 my $cache = <CACHE>;

863 close(CACHE);

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

866 PeerAddr => $Config{backend_address},

867 PeerPort => $Config{backend_port},

868 proto => "tcp",

869 Type => SOCK_STREAM

870 );

872 if ($socket) {

873 print $socket $cache;

874 close($socket);

875 $cache_was_sent = 1;

878 return $cache_was_sent;

881 sub save_cache_stat

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

884 for my $f (keys %Script_Files) {

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

887 close(CACHE);

890 sub load_cache_stat

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

893 while(<CACHE>) {

894 chomp;

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

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

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

899 close(CACHE);

904 main();

906 sub process_was_killed

908 $Killed = 1;

911 sub main

914 $| = 1;

916 init_variables();

917 init_config();

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

922 =cut

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

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

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

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

927 =cut

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

929 load_diff_files($lab_log);

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

932 sort_command_lines;

933 process_command_lines;

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

936 else {

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

938 my $pid = <PIDFILE>;

939 close(PIDFILE);

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

941 print "Removing stale pidfile\n";

942 unlink $Config{agent_pidfile}

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

944 }

945 else {

946 print "l3-agent is already running\n";

947 exit(0);

948 }

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

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

952 my $pid = fork;

953 exit if $pid;

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

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

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

958 print PIDFILE $$;

959 close(PIDFILE);

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

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

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

964 }

966 POSIX::setsid()

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

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

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

973 while (not $Killed) {

974 @Command_Lines = ();

975 @Command_Lines_Index = ();

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

977 load_diff_files($lab_log);

978 }

979 load_cache_stat();

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

981 if (@Command_Lines) {

982 sort_command_lines;

983 process_command_lines;

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

985 }

986 save_cache_stat();

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

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

989 }

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

993 unlink $Config{agent_pidfile};

998 sub init_variables