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