lilalo
view l3-agent @ 55:d3fcff5e3757
mywi ответы кэшируются + подсветка для записей с хинтами
| author | devi |
|---|---|
| date | Thu Dec 22 11:56:06 2005 +0200 (2005-12-22) |
| parents | f9447da96f15 |
| children | 43aeb3036aaa |
line source
1 #!/usr/bin/perl -w
3 #
4 # (c) Igor Chubin, imchubin@mail.ru, 2004-2005
5 #
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
55 {
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 # Это неправильно
74 #
75 # ВАРИАНТ:
76 # К файлам жураналам должны прилагаться ситемны файлы,
77 # мз которых и будет определяться соответствие
78 # имён пользователей их uid'ам
79 #
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++;
110 }
111 }
112 }
115 sub bind_diff
116 {
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 }
151 }
152 }
155 sub extract_from_cline
156 # Разобрать командную строку $_[1] и возвратить хэш, содержащий
157 # номер первого появление команды в строке:
158 # команда => первая позиция
159 {
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;
168 }
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+//;
178 }
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 };
192 }
193 }
195 if ($what eq "commands") {
196 return %commands;
197 } else {
198 return %files;
199 }
201 }
203 sub load_command_lines
204 {
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 }
280 }
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";
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);
600 }
601 if ($Config{"verbose"} =~ /y/) {
602 print "...finished." ;
603 print "Lines loaded: $commandlines_processed\n";
604 print "Command lines: $commandlines_loaded\n";
605 }
606 }
610 sub printq
611 {
612 my $TO = shift;
613 my $text = join "", @_;
614 $text =~ s/&/&/g;
615 $text =~ s/</</g;
616 $text =~ s/>/>/g;
617 print $TO $text;
618 }
621 sub sort_command_lines
622 {
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;
631 }
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/;
642 }
644 sub process_command_lines
645 {
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";
660 }
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 #}
706 }
708 }
711 =cut
712 Вывести результат обработки журнала.
713 =cut
716 sub print_command_lines
717 {
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;
736 }
737 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
738 $in_range=0;
739 next;
740 }
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;
757 }
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>",$out_class,"</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>";
829 }
830 if (@new_files) {
831 print OUT "<new_files>";
832 printq(\*OUT, join (" ", @new_files));
833 print OUT "</new_files>";
834 }
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";
842 }
843 if ($cl->{"note"}) {
844 print OUT "<note>";
845 printq(\*OUT,$cl->{"note"});
846 print OUT "</note>\n";
847 }
848 if ($cl->{"note_title"}) {
849 print OUT "<note_title>";
850 printq(\*OUT,$cl->{"note_title"});
851 print OUT "</note_title>\n";
852 }
853 print OUT "</command>\n";
855 }
857 #print OUT "</livelablog>\n";
858 close(OUT);
859 }
861 sub print_session
862 {
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"
873 }
874 print OUT "</session>\n";
875 close(OUT);
876 }
878 sub send_cache
879 {
880 # Если в кэше что-то накопилось,
881 # попытаемся отправить это на сервер
882 #
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;
901 }
902 }
903 return $cache_was_sent;
904 }
906 sub save_cache_stat
907 {
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";
911 }
912 close(CACHE);
913 }
915 sub load_cache_stat
916 {
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;
923 }
924 close(CACHE);
925 };
926 }
929 main();
931 sub process_was_killed
932 {
933 $Killed = 1;
934 }
936 sub main
937 {
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);
955 }
956 load_command_lines($Config{"input"}, $Config{"input_mask"});
957 sort_command_lines;
958 process_command_lines;
959 print_command_lines($Config{"cache"});
960 }
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 }
983 }
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;
1006 }
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);
1025 }
1027 unlink $Config{agent_pidfile};
1028 }
1030 }
1032 sub init_variables
1033 {
1034 }