lilalo: 196c82b6e538 l3-agent

lilalo

view l3-agent @ 31:196c82b6e538

l3-cgi:
* Сделана поддержка кодировок клиента отличных от utf-8 (пока что почему-то не работает)
* Сделана поддержка комментирования из самой командной строки.
Комментарии вставлюятся с помощью символов #^, #v или #=
Комментарии записываются в элементы note и note_title

l3-frontend:

* Сделана поддержка комментирования из самой командной строки.
Комментарии вставлюятся с помощью символов #^, #v или #=
* Вместо использования программы mywi-client, обращение к mywi-серверу выполняется самостоятельно
* Выполняется разбор команды с целью выявления новых команд, ведения статистики, генерирования подсказок и т.д.
* Во всплывающих командах к подсказкам выводится информация от mywi
* Выводится статистическая информация о журнале
"Время первой команды журнала"
"Время последней команды журнала"
"Количество командных строк в журнале"
"Процент команд с кодом ненулевым кодом завершения, %"
"Суммарное время работы с терминалом <sup><font size='-2'>*</font></sup>, час"
"Количество командных строк в единицу времени, команда/мин"
"Частота использования команд"
"Частота использования команд"
"Частота использования этих команд < 0.5%"
* В заголовке страницы выводится информация о курсе и имя слушателя
* Расшифровка к информации о курсе выводится только если есть сама информация
* В оглавлении учитваются пометки notes, вставленные с помощью #=
* Добавлена справка по использованию журнала

Новые параметры:
show_notes - нужно ли показывать заметки "notes"
> note_width - ширина заметок "notes"
mywi_server - IP-адрес сервера mywi
mywi_port - порт сервера mywi
stat_inactivity_interval - при подсчёте времени работы с терминалом,
интервалы превышающие какую длительность не должны учитываться, сек

author	devi
date	Fri Nov 11 21:29:49 2005 +0200 (2005-11-11)
parents	f5f07049bd4f
children	4d252e7dd478

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 $line .= "\n" unless $line =~ /^\s*$/;

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

550 }

551 }

552 else {

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

554 }

556 $vt->reset();

559 # Classifying the command line

562 # Save

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

564 # Changing encoding

565 for (keys %last_cl) {

566 next if /raw/;

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

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

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

570 }

571 push @Command_Lines, \%last_cl;

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

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

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

576 }

577 next;

578 }

579 $last_output_length+=length($_);

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

581 if ($last_output_length < 50000) {

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

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

584 }

585 else

586 {

587 if (!$skip_info) {

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

589 $skip_info = 1;

590 }

591 }

592 }

593 close(FILE);

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

597 print "...finished." ;

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

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

605 sub printq

607 my $TO = shift;

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

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

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

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

612 print $TO $text;

616 sub sort_command_lines

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

620 # Sort Command_Lines

621 # Write Command_Lines to Command_Lines_Index

623 my @index;

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

625 $index[$i]=$i;

628 @Command_Lines_Index = sort {

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

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

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

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

633 } @index;

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

639 sub process_command_lines

641 for my $i (@Command_Lines_Index) {

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

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

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

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

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

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

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

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

652 }

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

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

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

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

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

660 #tab# my $this_is_tab=1;

661 #tab#

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

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

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

665 #tab# $this_is_tab=0;

666 #tab# last;

667 #tab# }

668 #tab# }

669 #tab# }

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

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

674 # Command does not contain mistakes

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

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

679 # Searching for new commands only

680 for my $command (keys %commands) {

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

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

683 }

684 $Commands_Stat{$command}++;

685 }

687 for my $file (keys %files) {

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

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

690 }

691 $Files_Stat{$file}++;

692 }

693 }

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

696 # my $j=$i-1;

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

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

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

700 #}

706 =cut

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

708 =cut

711 sub print_command_lines

713 my $output_filename=$_[0];

714 my $mode = ">";

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

716 open(OUT, $mode, $output_filename)

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

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

723 my $cl;

724 my $in_range=0;

725 for my $i (@Command_Lines_Index) {

726 $cl = $Command_Lines[$i];

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

729 $in_range=1;

730 next;

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

733 $in_range=0;

734 next;

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

737 ||

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

739 ||

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

741 ||

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

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

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

747 my $cl_class="cline";

748 my $out_class="output";

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

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

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

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

756 my $output="";

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

758 # Partialy output

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

760 # head

761 my $mark=1;

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

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

764 }

765 # tail

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

767 if ($start < 0) {

768 $start=0;

769 $mark=0;

770 }

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

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

773 $mark=0;

774 }

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

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

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

778 }

779 }

780 else {

781 # Full output

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

783 }

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

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

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

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

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

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

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

795 my $year = 2005;

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

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

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

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

802 print OUT "<command>\n";

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

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

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

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

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

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

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

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

811 print OUT "<prompt>";

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

813 print OUT "</prompt>";

814 print OUT "<cline>";

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

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

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

818 if (@new_commands) {

819 print OUT "<new_commands>";

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

821 print OUT "</new_commands>";

823 if (@new_files) {

824 print OUT "<new_files>";

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

826 print OUT "</new_files>";

828 print OUT "<output>";

829 printq(\*OUT,$output);

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

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

832 print OUT "<diff>";

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

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

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

837 print OUT "<note>";

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

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

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

842 print OUT "<note_title>";

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

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

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

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

851 close(OUT);

854 sub print_session

856 my $output_filename = $_[0];

857 my $local_session_id = $_[1];

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

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

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

862 print OUT "<session>\n";

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

864 for my $key (keys %session) {

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

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

868 close(OUT);

871 sub send_cache

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

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

876 my $cache_was_sent=0;

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

879 local $/;

880 my $cache = <CACHE>;

881 close(CACHE);

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

884 PeerAddr => $Config{backend_address},

885 PeerPort => $Config{backend_port},

886 proto => "tcp",

887 Type => SOCK_STREAM

888 );

890 if ($socket) {

891 print $socket $cache;

892 close($socket);

893 $cache_was_sent = 1;

896 return $cache_was_sent;

899 sub save_cache_stat

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

902 for my $f (keys %Script_Files) {

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

905 close(CACHE);

908 sub load_cache_stat

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

911 while(<CACHE>) {

912 chomp;

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

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

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

917 close(CACHE);

922 main();

924 sub process_was_killed

926 $Killed = 1;

929 sub main

932 $| = 1;

934 init_variables();

935 init_config();

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

940 =cut

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

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

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

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

945 =cut

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

947 load_diff_files($lab_log);

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

950 sort_command_lines;

951 process_command_lines;

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

954 else {

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

956 my $pid = <PIDFILE>;

957 close(PIDFILE);

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

959 print "Removing stale pidfile\n";

960 unlink $Config{agent_pidfile}

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

962 }

963 else {

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

965 exit(0);

966 }

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

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

970 my $pid = fork;

971 exit if $pid;

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

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

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

976 print PIDFILE $$;

977 close(PIDFILE);

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

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

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

982 }

984 POSIX::setsid()

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

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

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

991 while (not $Killed) {

992 @Command_Lines = ();

993 @Command_Lines_Index = ();

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

995 load_diff_files($lab_log);

996 }

997 load_cache_stat();

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

999 if (@Command_Lines) {

1000 sort_command_lines;

1001 process_command_lines;

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

1003 }

1004 save_cache_stat();

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

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

1007 }

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

1011 unlink $Config{agent_pidfile};

1016 sub init_variables