lilalo: 568bab7090fc l3-agent

lilalo

view l3-agent @ 48:568bab7090fc

l3-cgi:
Журналы могут быть сохранены в файл,

l3:
Отправка файлов журналов по электронной почте.
l3 do send-logs

Новые параметры:
cgi2file - имя файла, в который будет выполняться запись
cgi_path_info - путь к странице, которая должна быть записана в файл
(то что вводится в браузер после l3/location)

author	devi
date	Sat Nov 26 16:15:52 2005 +0200 (2005-11-26)
parents	4d252e7dd478
children	ff4ab09fd3f1

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 Time::Local 'timelocal_nocheck';

12 use IO::Socket;

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

15 use l3config;

18 our @Command_Lines;

19 our @Command_Lines_Index;

20 our %Diffs;

21 our %Sessions;

23 our %Commands_Stat; # Statistics about commands usage

24 our %Files_Stat; # Statistics about commands usage

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

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

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

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

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

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

34 sub init_variables;

35 sub main;

37 sub load_diff_files;

38 sub bind_diff;

39 sub extract_from_cline;

40 sub load_command_lines;

41 sub sort_command_lines;

42 sub process_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 = @_;

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

62 my %diff;

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

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

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

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

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

71 # ВАРИАНТ:

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

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

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

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

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

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

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

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

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

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

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

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

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

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;

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

103 #push @Diffs, \%diff;

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

105 $i++;

111 sub bind_diff

113 # my $path = shift;

114 # my $pid = shift;

115 # my $day = shift;

116 # my $lab = shift;

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

120 my $cl = shift;

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

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

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

125 my $min_dt = 10000;

127 for my $diff_key (keys %Diffs) {

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

129 # Check here date, time and user

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

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

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

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

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

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

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

138 };

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

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

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

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

144 $min_dt = $dt;

145 }

151 sub extract_from_cline

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

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

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

156 my $what = $_[0];

157 my $cline = $_[1];

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

161 my @commands = ();

162 for my $list (@lists) {

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

166 my %commands;

167 my %files;

168 my $i=0;

169 for my $command (@commands) {

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

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

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

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

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

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

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

178 };

179 if ($2) {

180 my $args = $2;

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

182 for my $a (@args) {

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

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

185 };

187

191 if ($what eq "commands") {

192 return %commands;

193 } else {

194 return %files;

199 sub load_command_lines

201 my $lab_scripts_path = $_[0];

202 my $lab_scripts_mask = $_[1];

204 my $cline_re_base = qq'

205 (

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

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

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

209 (...?) # day

210 (.?.?) # lab

211 \\s # space separator

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

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

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

215 (.*) # command line

216 )

217 ';

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

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

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

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

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

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

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

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

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

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

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

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

234 my $file;

235 my $skip_info;

237 my $commandlines_loaded =0;

238 my $commandlines_processed =0;

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

241 for $file (@lab_scripts){

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

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

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

248 my $local_session_id;

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

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

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

252 $local_session_id = $1;

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

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

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

257 my $session_file = $file;

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

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

260 local $/;

261 my $data = <SESSION>;

262 close(SESSION);

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

265 my %session;

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

267 $session{$1} = $2;

268 }

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

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

271 }

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

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

275 }

278 open (FILE, "$file");

279 binmode FILE;

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

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

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

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

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

289 my $tty = $1;

290 my $first_pass = 1;

291 my %cl;

292 my $last_output_length=0;

293 while (<FILE>) {

295 $commandlines_processed++;

296 # time

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

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

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

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

303 # next;

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

305 # }

306 m/$cline_re2/gs;

308 $commandlines_loaded++;

309 $last_output_length=0;

311 # Previous command

312 my %last_cl = %cl;

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

316 =cut

318 Атрибуты cline

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

321 uid

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

324 tty

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

327 pid

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

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

331 lab

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

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

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

336 pwd (!)

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

339 day

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

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

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

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

346 hour

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

349 min

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

352 sec

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

355 time (!)

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

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

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

360 fullprompt

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

363 prompt

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

366 cline

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

369 output

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

372 diff

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

375 note (!)

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

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

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

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

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

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

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

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

384 Текст

385 ^D

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

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

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

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

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

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

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

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

396 err

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

399 histnum (!)

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

402 status (!)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

423 euid

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

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

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

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

430 version (!)

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

432 команды.

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

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

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

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

441 raw_file

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

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

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

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

447 raw_start

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

450 raw_output_start

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

453 raw_end

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

456 raw_cline

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

459 raw_data (*)

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

465 ТАБЛИЦА SESSION

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

469 (см. lm-install)

472 =cut

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

475 # Parse new command

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

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

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

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

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

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

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

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

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

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

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

488 {

489 use bytes;

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

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

492 }

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

495 $cl{"err"} = 0;

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

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

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

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

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

502 $cline_vt->reset();

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

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

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

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

509 if (

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

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

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

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

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

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

516 ) {

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

518 }

519 else {

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

521

522 }

523 $skip_info = 0;

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

528 # Processing previous command line

529 if ($first_pass) {

530 $first_pass = 0;

531 next;

532 }

534 # Error code

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

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

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

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

540 bind_diff(\%last_cl);

541 }

543 # Output

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

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

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

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

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

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

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

551 }

552 }

553 else {

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

555 }

557 $vt->reset();

560 # Classifying the command line

563 # Save

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

565 # Changing encoding

566 for (keys %last_cl) {

567 next if /raw/;

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

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

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

571 }

572 push @Command_Lines, \%last_cl;

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

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

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

577 }

578 next;

579 }

580 $last_output_length+=length($_);

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

582 if ($last_output_length < 50000) {

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

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

585 }

586 else

587 {

588 if (!$skip_info) {

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

590 $skip_info = 1;

591 }

592 }

593 }

594 close(FILE);

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

598 print "...finished." ;

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

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

606 sub printq

608 my $TO = shift;

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

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

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

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

613 print $TO $text;

617 sub sort_command_lines

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

621 # Sort Command_Lines

622 # Write Command_Lines to Command_Lines_Index

624 my @index;

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

626 $index[$i]=$i;

629 @Command_Lines_Index = sort {

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

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

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

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

634 } @index;

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

640 sub process_command_lines

642 for my $i (@Command_Lines_Index) {

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

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

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

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

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

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

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

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

653 }

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

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

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

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

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

661 #tab# my $this_is_tab=1;

662 #tab#

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

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

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

666 #tab# $this_is_tab=0;

667 #tab# last;

668 #tab# }

669 #tab# }

670 #tab# }

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

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

675 # Command does not contain mistakes

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

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

680 # Searching for new commands only

681 for my $command (keys %commands) {

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

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

684 }

685 $Commands_Stat{$command}++;

686 }

688 for my $file (keys %files) {

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

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

691 }

692 $Files_Stat{$file}++;

693 }

694 }

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

697 # my $j=$i-1;

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

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

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

701 #}

707 =cut

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

709 =cut

712 sub print_command_lines

714 my $output_filename=$_[0];

715 my $mode = ">";

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

717 open(OUT, $mode, $output_filename)

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

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

724 my $cl;

725 my $in_range=0;

726 for my $i (@Command_Lines_Index) {

727 $cl = $Command_Lines[$i];

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

730 $in_range=1;

731 next;

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

734 $in_range=0;

735 next;

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

738 ||

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

740 ||

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

742 ||

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

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

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

748 my $cl_class="cline";

749 my $out_class="output";

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

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

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

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

757 my $output="";

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

759 # Partialy output

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

761 # head

762 my $mark=1;

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

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

765 }

766 # tail

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

768 if ($start < 0) {

769 $start=0;

770 $mark=0;

771 }

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

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

774 $mark=0;

775 }

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

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

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

779 }

780 }

781 else {

782 # Full output

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

784 }

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

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

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

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

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

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

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

796 my $year = 2005;

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

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

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

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

803 print OUT "<command>\n";

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

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

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

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

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

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

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

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

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

813 print OUT "<prompt>";

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

815 print OUT "</prompt>";

816 print OUT "<cline>";

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

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

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

820 if (@new_commands) {

821 print OUT "<new_commands>";

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

823 print OUT "</new_commands>";

825 if (@new_files) {

826 print OUT "<new_files>";

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

828 print OUT "</new_files>";

830 print OUT "<output>";

831 printq(\*OUT,$output);

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

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

834 print OUT "<diff>";

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

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

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

839 print OUT "<note>";

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

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

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

844 print OUT "<note_title>";

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

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

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

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

853 close(OUT);

856 sub print_session

858 my $output_filename = $_[0];

859 my $local_session_id = $_[1];

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

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

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

864 print OUT "<session>\n";

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

866 for my $key (keys %session) {

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

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

870 close(OUT);

873 sub send_cache

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

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

878 my $cache_was_sent=0;

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

881 local $/;

882 my $cache = <CACHE>;

883 close(CACHE);

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

886 PeerAddr => $Config{backend_address},

887 PeerPort => $Config{backend_port},

888 proto => "tcp",

889 Type => SOCK_STREAM

890 );

892 if ($socket) {

893 print $socket $cache;

894 close($socket);

895 $cache_was_sent = 1;

898 return $cache_was_sent;

901 sub save_cache_stat

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

904 for my $f (keys %Script_Files) {

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

907 close(CACHE);

910 sub load_cache_stat

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

913 while(<CACHE>) {

914 chomp;

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

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

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

919 close(CACHE);

924 main();

926 sub process_was_killed

928 $Killed = 1;

931 sub main

934 $| = 1;

936 init_variables();

937 init_config();

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

942 =cut

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

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

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

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

947 =cut

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

949 load_diff_files($lab_log);

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

952 sort_command_lines;

953 process_command_lines;

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

956 else {

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

958 my $pid = <PIDFILE>;

959 close(PIDFILE);

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

961 print "Removing stale pidfile\n";

962 unlink $Config{agent_pidfile}

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

964 }

965 else {

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

967 exit(0);

968 }

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

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

972 my $pid = fork;

973 exit if $pid;

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

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

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

978 print PIDFILE $$;

979 close(PIDFILE);

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

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

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

984 }

986 POSIX::setsid()

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

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

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

993 while (not $Killed) {

994 @Command_Lines = ();

995 @Command_Lines_Index = ();

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

997 load_diff_files($lab_log);

998 }

999 load_cache_stat();

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

1001 if (@Command_Lines) {

1002 sort_command_lines;

1003 process_command_lines;

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

1005 }

1006 save_cache_stat();

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

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

1009 }

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

1013 unlink $Config{agent_pidfile};

1018 sub init_variables