lilalo
view l3-agent @ 52:f9447da96f15
Исправлены глюки с фильтрами host/user
Правильно отрабатывается многократный запуск под FreeBSD
Исправлен глюк с автоматическим выделением URL в комментариях
Правильно отрабатывается многократный запуск под FreeBSD
Исправлен глюк с автоматическим выделением URL в комментариях
| author | devi |
|---|---|
| date | Wed Dec 21 14:39:44 2005 +0200 (2005-12-21) |
| parents | ff4ab09fd3f1 |
| children | eab4f7df854c |
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 # timelocal( $sec, $min, $hour, $mday,$mon,$year);
803 $cl->{time} = timelocal_nocheck($cl->{sec},$cl->{min},$cl->{hour},$cl->{day},0,$year);
806 # Начинаем вывод команды
807 print OUT "<command>\n";
808 print OUT "<local_session_id>",$cl->{local_session_id},"</local_session_id>\n";
809 print OUT "<time>",$cl->{time},"</time>\n";
810 print OUT "<raw_start>",$cl->{raw_start},"</raw_start>\n";
811 print OUT "<raw_output_start>",$cl->{raw_output_start},"</raw_output_start>\n";
812 print OUT "<raw_end>",$cl->{raw_end},"</raw_end>\n";
813 print OUT "<raw_file>",$cl->{raw_file},"</raw_file>\n";
814 print OUT "<tty>",$cl->{tty},"</tty>\n";
815 print OUT "<out_class>",$out_class,"</out_class>\n";
816 print OUT "<err>",$out_class,"</err>\n";
817 print OUT "<prompt>";
818 printq(\*OUT,,$cl->{"prompt"});
819 print OUT "</prompt>";
820 print OUT "<cline>";
821 printq(\*OUT,$cl->{"cline"});
822 print OUT "</cline>\n";
823 print OUT "<last_command>",$cl->{"last_command"},"</last_command>\n";
824 if (@new_commands) {
825 print OUT "<new_commands>";
826 printq(\*OUT, join (" ", @new_commands));
827 print OUT "</new_commands>";
828 }
829 if (@new_files) {
830 print OUT "<new_files>";
831 printq(\*OUT, join (" ", @new_files));
832 print OUT "</new_files>";
833 }
834 print OUT "<output>";
835 printq(\*OUT,$output);
836 print OUT "</output>\n";
837 if ($cl->{"diff"}) {
838 print OUT "<diff>";
839 printq(\*OUT,${$Diffs{$cl->{"diff"}}}{"text"});
840 print OUT "</diff>\n";
841 }
842 if ($cl->{"note"}) {
843 print OUT "<note>";
844 printq(\*OUT,$cl->{"note"});
845 print OUT "</note>\n";
846 }
847 if ($cl->{"note_title"}) {
848 print OUT "<note_title>";
849 printq(\*OUT,$cl->{"note_title"});
850 print OUT "</note_title>\n";
851 }
852 print OUT "</command>\n";
854 }
856 #print OUT "</livelablog>\n";
857 close(OUT);
858 }
860 sub print_session
861 {
862 my $output_filename = $_[0];
863 my $local_session_id = $_[1];
864 return if not defined($Sessions{$local_session_id});
866 open(OUT, ">>", $output_filename)
867 or die "Can't open $output_filename for writing\n";
868 print OUT "<session>\n";
869 my %session = %{$Sessions{$local_session_id}};
870 for my $key (keys %session) {
871 print OUT "<$key>".$session{$key}."</$key>\n"
872 }
873 print OUT "</session>\n";
874 close(OUT);
875 }
877 sub send_cache
878 {
879 # Если в кэше что-то накопилось,
880 # попытаемся отправить это на сервер
881 #
882 my $cache_was_sent=0;
884 if (open(CACHE, $Config{cache})) {
885 local $/;
886 my $cache = <CACHE>;
887 close(CACHE);
889 my $socket = IO::Socket::INET->new(
890 PeerAddr => $Config{backend_address},
891 PeerPort => $Config{backend_port},
892 proto => "tcp",
893 Type => SOCK_STREAM
894 );
896 if ($socket) {
897 print $socket $cache;
898 close($socket);
899 $cache_was_sent = 1;
900 }
901 }
902 return $cache_was_sent;
903 }
905 sub save_cache_stat
906 {
907 open (CACHE, ">$Config{cache_stat}");
908 for my $f (keys %Script_Files) {
909 print CACHE "$f\t",$Script_Files{$f}->{size},"\t",$Script_Files{$f}->{tell},"\n";
910 }
911 close(CACHE);
912 }
914 sub load_cache_stat
915 {
916 if (open (CACHE, "$Config{cache_stat}")) {
917 while(<CACHE>) {
918 chomp;
919 my ($f, $size, $tell) = split /\t/;
920 $Script_Files{$f}->{size} = $size;
921 $Script_Files{$f}->{tell} = $tell;
922 }
923 close(CACHE);
924 };
925 }
928 main();
930 sub process_was_killed
931 {
932 $Killed = 1;
933 }
935 sub main
936 {
938 $| = 1;
940 init_variables();
941 init_config();
944 if ($Config{"mode"} ne "daemon") {
946 =cut
947 В нормальном режиме работы нужно
948 считать скрипты, обработать их и записать
949 результат выполнения в результриующий файл.
950 После этого завершить работу.
951 =cut
952 for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) {
953 load_diff_files($lab_log);
954 }
955 load_command_lines($Config{"input"}, $Config{"input_mask"});
956 sort_command_lines;
957 process_command_lines;
958 print_command_lines($Config{"cache"});
959 }
960 else {
961 if (open(PIDFILE, $Config{agent_pidfile})) {
962 my $pid = <PIDFILE>;
963 close(PIDFILE);
964 if ($^O eq 'linux' && (! -e "/proc/$pid" || !`grep $Config{"l3-agent"} /proc/$pid/cmdline && grep "uid:.*\b$<\b" /proc/$pid/status`)) {
965 print "Removing stale pidfile\n";
966 unlink $Config{agent_pidfile}
967 or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!";
968 }
969 elsif ($^O eq 'freebsd' && !`ps axo uid,pid,command | grep '$<.*$pid.*$Config{"l3-agent"}' 2> /dev/null`) {
970 }
971 elsif ($^O eq 'linux' || $^O eq 'freebsd' ) {
972 print "l3-agent is already running\n";
973 exit(0);
974 }
975 else {
976 print "Unknown operating system";
977 exit(0);
978 }
979 }
980 if ($Config{detach} =~ /^y/i) {
981 #$Config{verbose} = "no";
982 my $pid = fork;
983 exit if $pid;
984 die "Couldn't fork: $!" unless defined ($pid);
986 open(PIDFILE, ">", $Config{agent_pidfile})
987 or die "Can't open pidfile ". $Config{agent_pidfile}. " for wrting: $!";
988 print PIDFILE $$;
989 close(PIDFILE);
991 for my $handle (*STDIN, *STDOUT, *STDERR) {
992 open ($handle, "+<", "/dev/null")
993 or die "can't reopen $handle to /dev/null: $!"
994 }
996 POSIX::setsid()
997 or die "Can't start a new session: $!";
999 $0 = $Config{"l3-agent"};
1001 $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&process_was_killed;
1002 }
1003 while (not $Killed) {
1004 @Command_Lines = ();
1005 @Command_Lines_Index = ();
1006 for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) {
1007 load_diff_files($lab_log);
1008 }
1009 load_cache_stat();
1010 load_command_lines($Config{"input"}, $Config{"input_mask"});
1011 if (@Command_Lines) {
1012 sort_command_lines;
1013 process_command_lines;
1014 print_command_lines($Config{"cache"});
1015 }
1016 save_cache_stat();
1017 if (-e $Config{cache} && (stat($Config{cache}))[7]) {
1018 send_cache() && unlink($Config{cache});
1019 }
1020 sleep($Config{"daemon_sleep_interval"} || 1);
1021 }
1023 unlink $Config{agent_pidfile};
1024 }
1026 }
1028 sub init_variables
1029 {
1030 }