lilalo
view l3-agent @ 37:219389279acb
Множество изменений, которые были сделаны в ходе
первой обкатки LiLaLo в реальных условиях.
Добавлена фильтрация и возможность просмотра
смешанного журнала с хоста, без разделения по пользователям
первой обкатки LiLaLo в реальных условиях.
Добавлена фильтрация и возможность просмотра
смешанного журнала с хоста, без разделения по пользователям
| author | devi |
|---|---|
| date | Fri Nov 18 17:46:09 2005 +0200 (2005-11-18) |
| parents | 4d252e7dd478 |
| children | ff4ab09fd3f1 |
line source
1 #!/usr/bin/perl -w
3 #
4 # (c) Igor Chubin, imchubin@mail.ru, 2004-2005
5 #
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
51 {
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 # Это неправильно
70 #
71 # ВАРИАНТ:
72 # К файлам жураналам должны прилагаться ситемны файлы,
73 # мз которых и будет определяться соответствие
74 # имён пользователей их uid'ам
75 #
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++;
106 }
107 }
108 }
111 sub bind_diff
112 {
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 }
147 }
148 }
151 sub extract_from_cline
152 # Разобрать командную строку $_[1] и возвратить хэш, содержащий
153 # номер первого появление команды в строке:
154 # команда => первая позиция
155 {
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;
164 }
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+//;
174 }
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 };
188 }
189 }
191 if ($what eq "commands") {
192 return %commands;
193 } else {
194 return %files;
195 }
197 }
199 sub load_command_lines
200 {
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 }
276 }
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";
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);
596 }
597 if ($Config{"verbose"} =~ /y/) {
598 print "...finished." ;
599 print "Lines loaded: $commandlines_processed\n";
600 print "Command lines: $commandlines_loaded\n";
601 }
602 }
606 sub printq
607 {
608 my $TO = shift;
609 my $text = join "", @_;
610 $text =~ s/&/&/g;
611 $text =~ s/</</g;
612 $text =~ s/>/>/g;
613 print $TO $text;
614 }
617 sub sort_command_lines
618 {
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;
627 }
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/;
638 }
640 sub process_command_lines
641 {
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";
656 }
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 #}
702 }
704 }
707 =cut
708 Вывести результат обработки журнала.
709 =cut
712 sub print_command_lines
713 {
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;
732 }
733 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
734 $in_range=0;
735 next;
736 }
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;
753 }
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>";
824 }
825 if (@new_files) {
826 print OUT "<new_files>";
827 printq(\*OUT, join (" ", @new_files));
828 print OUT "</new_files>";
829 }
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";
837 }
838 if ($cl->{"note"}) {
839 print OUT "<note>";
840 printq(\*OUT,$cl->{"note"});
841 print OUT "</note>\n";
842 }
843 if ($cl->{"note_title"}) {
844 print OUT "<note_title>";
845 printq(\*OUT,$cl->{"note_title"});
846 print OUT "</note_title>\n";
847 }
848 print OUT "</command>\n";
850 }
852 #print OUT "</livelablog>\n";
853 close(OUT);
854 }
856 sub print_session
857 {
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"
868 }
869 print OUT "</session>\n";
870 close(OUT);
871 }
873 sub send_cache
874 {
875 # Если в кэше что-то накопилось,
876 # попытаемся отправить это на сервер
877 #
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;
896 }
897 }
898 return $cache_was_sent;
899 }
901 sub save_cache_stat
902 {
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";
906 }
907 close(CACHE);
908 }
910 sub load_cache_stat
911 {
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;
918 }
919 close(CACHE);
920 };
921 }
924 main();
926 sub process_was_killed
927 {
928 $Killed = 1;
929 }
931 sub main
932 {
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);
950 }
951 load_command_lines($Config{"input"}, $Config{"input_mask"});
952 sort_command_lines;
953 process_command_lines;
954 print_command_lines($Config{"cache"});
955 }
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 }
969 }
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;
992 }
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);
1011 }
1013 unlink $Config{agent_pidfile};
1014 }
1016 }
1018 sub init_variables
1019 {
1020 }