lilalo
view l3-agent @ 28:450b6ac9b657
Незначительные исправления:
* Исправлена обработка diff-файлов. Теперь они обрабатываются
в реальном времени
* Указан путь к mywi-client
* Исправлен путь к иконкам google/freebsd/linux
* Исправлена обработка diff-файлов. Теперь они обрабатываются
в реальном времени
* Указан путь к mywi-client
* Исправлен путь к иконкам google/freebsd/linux
| author | devi |
|---|---|
| date | Mon Nov 07 12:23:13 2005 +0200 (2005-11-07) |
| parents | 098664cf339c |
| children | f5f07049bd4f |
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 Data::Dumper;
12 use Time::Local 'timelocal_nocheck';
13 use IO::Socket;
15 use lib ".";
16 use l3config;
19 our @Command_Lines;
20 our @Command_Lines_Index;
21 our %Diffs;
22 our %Sessions;
24 our %Commands_Stat; # Statistics about commands usage
25 our %Files_Stat; # Statistics about commands usage
27 our %Script_Files; # Информация о позициях в скрипт-файлах,
28 # до которых уже выполнен разбор
29 # и информация о времени модификации файла
30 # $Script_Files{$file}->{size}
31 # $Script_Files{$file}->{tell}
33 our $Killed =0; # В режиме демона -- процесс получил сигнал о завершении
35 sub init_variables;
36 sub main;
38 sub load_diff_files;
39 sub bind_diff;
40 sub extract_from_cline;
41 sub load_command_lines;
42 sub sort_command_lines;
43 sub process_command_lines;
44 sub print_command_lines;
45 sub printq;
47 sub save_cache_stat;
48 sub load_cache_stat;
49 sub print_session;
51 sub load_diff_files
52 {
53 my @pathes = @_;
55 for my $path (@pathes) {
56 my $template = "*.diff";
57 my @files = <$path/$template>;
58 my $i=0;
59 for my $file (@files) {
61 next if defined($Diffs{$file});
63 my %diff;
65 $diff{"path"}=$path;
66 $diff{"uid"}="SET THIS";
68 # Сейчас UID определяется из названия каталога
69 # откуда берутся diff-файлы
70 # Это неправильно
71 #
72 # ВАРИАНТ:
73 # К файлам жураналам должны прилагаться ситемны файлы,
74 # мз которых и будет определяться соответствие
75 # имён пользователей их uid'ам
76 #
77 $diff{"uid"} = 0 if $path =~ m@/root/@;
79 $diff{"bind_to"}="";
80 $diff{"time_range"}=-1;
82 next if not $file=~m@/(D?[0-9][0-9]?[0-9]?)[^/]*?([0-9]*):([0-9]*):?([0-9]*)@;
83 $diff{"day"}=$1 || "";
84 $diff{"hour"}=$2;
85 $diff{"min"}=$3;
86 $diff{"sec"}=$4 || 0;
88 $diff{"index"}=$i;
90 print "diff loaded: $diff{day} $diff{hour}:$diff{min}:$diff{sec}\n";
92 local $/;
93 open (F, "$file")
94 or return "Can't open file $file ($_[0]) for reading";
95 my $text = <F>;
96 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i) {
97 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8");
98 $text = $converter->convert($text);
99 }
100 close(F);
101 $diff{"text"}=$text;
102 #print "$file loaded ($diff{day})\n";
104 #push @Diffs, \%diff;
105 $Diffs{$file} = \%diff;
106 $i++;
107 }
108 }
109 }
112 sub bind_diff
113 {
114 # my $path = shift;
115 # my $pid = shift;
116 # my $day = shift;
117 # my $lab = shift;
119 print "Trying to bind diff...\n";
121 my $cl = shift;
122 my $hour = $cl->{"hour"};
123 my $min = $cl->{"min"};
124 my $sec = $cl->{"sec"};
126 my $min_dt = 10000;
128 for my $diff_key (keys %Diffs) {
129 my $diff = $Diffs{$diff_key};
130 # Check here date, time and user
131 next if ($diff->{"day"} && $cl->{"day"} && ($cl->{"day"} ne $diff->{"day"}));
132 #next if (!$diff->{"uid"} && $cl->{"euid"} != $diff->{"uid"});
134 my $dt=($diff->{"hour"}-$hour)*3600 +($diff->{"min"}-$min)*60 + ($diff->{"sec"}-$sec);
135 if ($dt >0 && $dt < $min_dt && ($diff->{"time_range"} <0 || $dt < $diff->{"time_range"})) {
136 print "Approppriate diff found: dt=$dt\n";
137 if ($diff->{"bind_to"}) {
138 undef $diff->{"bind_to"}->{"diff"};
139 };
140 $diff->{"time_range"}=$dt;
141 $diff->{"bind_to"}=$cl;
143 #$cl->{"diff"} = $diff->{"index"};
144 $cl->{"diff"} = $diff_key;
145 $min_dt = $dt;
146 }
148 }
149 }
152 sub extract_from_cline
153 # Разобрать командную строку $_[1] и возвратить хэш, содержащий
154 # номер первого появление команды в строке:
155 # команда => первая позиция
156 {
157 my $what = $_[0];
158 my $cline = $_[1];
159 my @lists = split /\;/, $cline;
162 my @commands = ();
163 for my $list (@lists) {
164 push @commands, split /\|/, $list;
165 }
167 my %commands;
168 my %files;
169 my $i=0;
170 for my $command (@commands) {
171 $command =~ /\s*(\S+)\s*(.*)/;
172 if ($1 && $1 eq "sudo" ) {
173 $commands{"$1"}=$i++;
174 $command =~ s/\s*sudo\s+//;
175 }
176 $command =~ /\s*(\S+)\s*(.*)/;
177 if ($1 && !defined $commands{"$1"}) {
178 $commands{"$1"}=$i++;
179 };
180 if ($2) {
181 my $args = $2;
182 my @args = split (/\s+/, $args);
183 for my $a (@args) {
184 $files{"$a"}=$i++
185 if !defined $files{"$a"};
186 };
189 }
190 }
192 if ($what eq "commands") {
193 return %commands;
194 } else {
195 return %files;
196 }
198 }
200 sub load_command_lines
201 {
202 my $lab_scripts_path = $_[0];
203 my $lab_scripts_mask = $_[1];
205 my $cline_re_base = qq'
206 (
207 (?:\\^?([0-9]*C?)) # exitcode
208 (?:_([0-9]+)_)? # uid
209 (?:_([0-9]+)_) # pid
210 (...?) # day
211 (.?.?) # lab
212 \\s # space separator
213 ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) # time
214 .\\[50D.\\[K # killing symbols
215 (.*?([\$\#]\\s?)) # prompt
216 (.*) # command line
217 )
218 ';
219 #my $cline_re = qr/$cline_re_base(?:$cline_re_base|$)/x;
220 #my $cline_re = qr/(?:$cline_re_base)*$cline_re_base$/x;
221 my $cline_re = qr/$cline_re_base/sx;
222 my $cline_re1 = qr/$cline_re_base\x0D/sx;
223 my $cline_re2 = qr/$cline_re_base$/sx;
225 my $vt = Term::VT102->new ( 'cols' => $Config{"terminal_width"},
226 'rows' => $Config{"terminal_height"});
227 my $cline_vt = Term::VT102->new ('cols' => $Config{"terminal_width"},
228 'rows' => $Config{"terminal_height"});
230 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8")
231 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i);
233 print "Loading lm-scripts...\n" if $Config{"verbose"} =~ /y/;
235 my $file;
236 my $skip_info;
238 my $commandlines_loaded =0;
239 my $commandlines_processed =0;
241 my @lab_scripts = <$lab_scripts_path/$lab_scripts_mask>;
242 for $file (@lab_scripts){
244 # Пропускаем файл, если он не изменялся со времени нашего предудущего прохода
245 my $size = (stat($file))[7];
246 next if ($Script_Files{$file} && $Script_Files{$file}->{size} && $Script_Files{$file}->{size} >= $size);
249 my $local_session_id;
250 # Начальное значение идентификатора текущего сеанса определяем из имени скрипта
251 # Впоследствии оно может быть уточнено
252 $file =~ /.*\/(.*)\.script$/;
253 $local_session_id = $1;
255 #Если файл только что появился,
256 #пытаемся найти и загрузить информацию о соответствующей ему сессии
257 if (!$Script_Files{$file}) {
258 my $session_file = $file;
259 $session_file =~ s/\.script/.info/;
260 if (open(SESSION, $session_file)) {
261 local $/;
262 my $data = <SESSION>;
263 close(SESSION);
265 for my $session_data ($data =~ m@<session>(.*?)</session>@sg) {
266 my %session;
267 while ($session_data =~ m@<([^>]*?)>(.*?)</\1>@sg) {
268 $session{$1} = $2;
269 }
270 $local_session_id = $session{"local_session_id"} if $session{"local_session_id"};
271 $Sessions{$local_session_id}=\%session;
272 }
274 #Загруженную информацию сразу же отправляем в поток
275 print_session($Config{cache}, $local_session_id);
276 }
277 }
279 open (FILE, "$file");
280 binmode FILE;
282 # Переходим к тому месту, где мы окончили разбор
283 seek (FILE, $Script_Files{$file}->{tell}, 0) if $Script_Files{$file}->{tell};
284 $Script_Files{$file}->{size} = $size;
285 $Script_Files{$file}->{tell} = 0 unless $Script_Files{$file}->{tell};
288 $file =~ m@.*/(.*?)-.*@;
290 my $tty = $1;
291 my $first_pass = 1;
292 my %cl;
293 my $last_output_length=0;
294 while (<FILE>) {
296 $commandlines_processed++;
297 # time
299 if (/[0-9][0-9]:[0-9][0-9]:[0-9][0-9].\[[0-9][0-9]D.\[K/ && m/$cline_re/) {
300 s/.*\x0d(?!\x0a)//;
301 # print "!!!",$_,"!!!\n";
302 # next;
303 # while (m/$cline_re1/gs) {
304 # }
305 m/$cline_re2/gs;
307 $commandlines_loaded++;
308 $last_output_length=0;
310 # Previous command
311 my %last_cl = %cl;
312 my $err = $2 || "";
315 =cut
317 Атрибуты cline
318 Список полей, характеризующих командную строку
320 uid
321 Идентификатор пользователя
323 tty
324 Идентификатор терминала, на котором была вызвана команда
326 pid
327 PID-процесса командного интерпретатора,
328 в котором была вызвана команда
330 lab
331 лабораторная работа, к которой относится команда.
332 Идентификатор текущей лабораторной работы
333 хранится в файле ~/.labmaker/lab
335 pwd (!)
336 текущий каталог, из которого была вызвана команда
338 day
339 время вызова, день
340 В действительности здесь хранится не время вызова команды,
341 а с момента появления приглашения командного интерпретатора
342 для ввода команды
345 hour
346 время вызова, час
348 min
349 время вызова, минута
351 sec
352 время вызова, секунда
354 time (!)
355 время вызова команды в Unix-формате.
356 Предпочтительнее использовать этот формат чем hour:min:sec,
357 использовавшийся в Labmaker
359 fullprompt
360 Приглашение командной строки
362 prompt
363 Сокращённое приглашение командной строки
365 cline
366 Командная строка
368 output
369 Результат выполнения команды
371 diff
372 Указатель на ассоциированный с командой diff
374 note (!)
375 Текстовый комментарий к команде.
376 Может генерироваться из самого лога с помощью команд
377 #^ Комментарий
378 #= Комментарий
379 #v Комментарий
380 в том случае, если для комментирования достаточно одной строки,
381 или с помощью команд
382 cat > /dev/null #^ Заголовок
383 Текст
384 ^D
385 в том случае, если комментарий развёрнутый.
386 В последнем случае комментарий может содержать
387 заголовок, абзацы и несложное форматирование.
389 Символы ^, v или = после знака комментария # обозначает,
390 к какой команде относится комментарий:
391 к предыдущей (^), последующей (v)
392 или это общий комментарий по тексту, не относящийся непосредственно
393 ни к одной из них (=)
395 err
396 Код завершения командной строки
398 histnum (!)
399 Номер команды в истории командного интерпретатора
401 status (!)
402 Является ли данная команда вызванной (r), запомненной (s)
403 или это подсказка completion (c).
405 Команды, которые были вызваны и обработаны интерпретатором
406 имеют состояние "r". К таким командам относится большинство
407 команд вводимых в интерпретатор.
409 Если команда набрана, но вызывать её по какой-либо причине
410 не хочется (например, команда может быть не полной, вредоносной
411 или просто бессмысленной в текущих условиях),
412 её можно сбросить с помощью комбинации клавиш Ctrl-C
413 (не путайте с прерыванием работающей команды! здесь она даже
414 не запускается!).
415 В таком случае она не выполняется, но попадает в журнал
416 со статусом "s".
418 Если команда появилась в журнале благодаря автопроолжению
419 -- когда было показано несколько вариантов --
420 она имеет статус "c".
422 euid
423 Идентификатор пользователя от имени которого будет
424 выполняться команда.
425 Может отличаться от реального uid в том случае,
426 если вызывается с помощью sudo
429 version (!)
430 Версия lilalo-prompt использовавшаяся при записи
431 команды.
433 0 - версия использовавшая в labmaker.
434 Отсутствует информация о текущем каталоге и номере в истории.
435 Информация о версии также не указана в приглашении.
438 1 - версия использующаяся в lilalo
440 raw_file
441 Имя файла, в котором находится бинарное представление журнала.
442 Может содержать ключевое слово HERE,
443 обозначающее что бинарное представление хранится
444 непосредственно в базе данных в атрибуте raw_data
446 raw_start
447 Начало блока командной строки в файле бинарного представления
449 raw_output_start
450 Начало блока вывода
452 raw_end
453 Конец блока командной строки в файле бинарного представления
455 raw_cline
456 Необработанная командная строка (без приглашения) в бинарном виде
458 raw_data (*)
459 Бинарное представление команды и результатов её выполнения
464 ТАБЛИЦА SESSION
466 Информация о сеансах
468 (см. lm-install)
471 =cut
473 $cl{"local_session_id"} = $local_session_id;
474 # Parse new command
475 $cl{"uid"} = $3;
476 $cl{"euid"} = $cl{"uid"}; # Если в команде обнаружится sudo, euid поменяем на 0
477 $cl{"pid"} = $4;
478 $cl{"day"} = $5;
479 $cl{"lab"} = $6;
480 $cl{"hour"} = $7;
481 $cl{"min"} = $8;
482 $cl{"sec"} = $9;
483 $cl{"fullprompt"} = $10;
484 $cl{"prompt"} = $11;
485 $cl{"raw_cline"} = $12;
487 {
488 use bytes;
489 $cl{"raw_start"} = tell (FILE) - length($1);
490 $cl{"raw_output_start"} = tell FILE;
491 }
492 $cl{"raw_file"} = $file;
494 $cl{"err"} = 0;
495 $cl{"output"} = "";
496 $cl{"tty"} = $tty;
498 $cline_vt->process($cl{"raw_cline"}."\n");
499 $cl{"cline"} = $cline_vt->row_plaintext (1);
500 $cl{"cline"} =~ s/\s*$//;
501 $cline_vt->reset();
503 my %commands = extract_from_cline("commands", $cl{"cline"});
504 $cl{"euid"}=0 if defined $commands{"sudo"};
505 my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands;
506 $cl{"last_command"} = $comms[$#comms] || "";
508 if (
509 $Config{"suppress_editors"} =~ /^y/i
510 && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}}) ||
511 $Config{"suppress_pagers"} =~ /^y/i
512 && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}}) ||
513 $Config{"suppress_terminal"}=~ /^y/i
514 && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}})
515 ) {
516 $cl{"suppress_output"} = "1";
517 }
518 else {
519 $cl{"suppress_output"} = "0";
521 }
522 $skip_info = 0;
525 print " ",$cl{"last_command"};
527 # Processing previous command line
528 if ($first_pass) {
529 $first_pass = 0;
530 next;
531 }
533 # Error code
534 $last_cl{"raw_end"} = $cl{"raw_start"};
535 $last_cl{"err"}=$err;
536 $last_cl{"err"}=130 if $err eq "^C";
538 if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) {
539 bind_diff(\%last_cl);
540 }
542 # Output
543 if (!$last_cl{"suppress_output"} || $last_cl{"err"}) {
544 for (my $i=0; $i<$Config{"terminal_height"}; $i++) {
545 my $line= $vt->row_plaintext($i);
546 next if !defined ($line) || $line =~ /^\s*$/;
547 $line =~ s/\s*$//;
548 $last_cl{"output"} .= $line."\n";
549 }
550 }
551 else {
552 $last_cl{"output"}= "";
553 }
555 $vt->reset();
558 # Classifying the command line
561 # Save
562 if (!$Config{"lab"} || $cl{"lab"} eq $Config{"lab"}) {
563 # Changing encoding
564 for (keys %last_cl) {
565 next if /raw/;
566 $last_cl{$_} = $converter->convert($last_cl{$_})
567 if ($Config{"encoding"} &&
568 $Config{"encoding"} !~ /^utf-8$/i);
569 }
570 push @Command_Lines, \%last_cl;
572 # Сохранение позиции в файле, до которой выполнен
573 # успешный разбор
574 $Script_Files{$file}->{tell} = $last_cl{raw_end};
575 }
576 next;
577 }
578 $last_output_length+=length($_);
579 #if (!$cl{"suppress_output"} || $last_output_length < 5000) {
580 if ($last_output_length < 50000) {
581 #print "(",length($_),")" if (length($_) > 2000) ;
582 $vt->process("$_"."\n")
583 }
584 else
585 {
586 if (!$skip_info) {
587 print "($cl{last_command})";
588 $skip_info = 1;
589 }
590 }
591 }
592 close(FILE);
594 }
595 if ($Config{"verbose"} =~ /y/) {
596 print "...finished." ;
597 print "Lines loaded: $commandlines_processed\n";
598 print "Command lines: $commandlines_loaded\n";
599 }
600 }
604 sub printq
605 {
606 my $TO = shift;
607 my $text = join "", @_;
608 $text =~ s/&/&/g;
609 $text =~ s/</</g;
610 $text =~ s/>/>/g;
611 print $TO $text;
612 }
615 sub sort_command_lines
616 {
617 print "Sorting command lines...\n" if $Config{"verbose"} =~ /y/;
619 # Sort Command_Lines
620 # Write Command_Lines to Command_Lines_Index
622 my @index;
623 for (my $i=0;$i<=$#Command_Lines;$i++) {
624 $index[$i]=$i;
625 }
627 @Command_Lines_Index = sort {
628 $Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"} ||
629 $Command_Lines[$index[$a]]->{"hour"} <=> $Command_Lines[$index[$b]]->{"hour"} ||
630 $Command_Lines[$index[$a]]->{"min"} <=> $Command_Lines[$index[$b]]->{"min"} ||
631 $Command_Lines[$index[$a]]->{"sec"} <=> $Command_Lines[$index[$b]]->{"sec"}
632 } @index;
634 print "...finished\n" if $Config{"verbose"} =~ /y/;
636 }
638 sub process_command_lines
639 {
640 for my $i (@Command_Lines_Index) {
642 my $cl = \$Command_Lines[$i];
643 @{${$cl}->{"new_commands"}} =();
644 @{${$cl}->{"new_files"}} =();
645 $$cl->{"class"} = "";
647 if ($$cl->{"err"}) {
648 $$cl->{"class"}="wrong";
649 $$cl->{"class"}="interrupted"
650 if ($$cl->{"err"} eq 130);
651 }
652 if (!$$cl->{"euid"}) {
653 $$cl->{"class"}.="_root";
654 }
656 #tab# my @tab_words=split /\s+/, $$cl->{"output"};
657 #tab# my $last_word= $$cl->{"cline"} =~ /(\S*)$/;
658 #tab# $last_word =~ s@.*/@@;
659 #tab# my $this_is_tab=1;
660 #tab#
661 #tab# if ($last_word && @tab_words >2) {
662 #tab# for my $tab_words (@tab_words) {
663 #tab# if ($tab_words !~ /^$last_word/) {
664 #tab# $this_is_tab=0;
665 #tab# last;
666 #tab# }
667 #tab# }
668 #tab# }
669 #tab# $$cl->{"class"}="tab" if $this_is_tab;
672 if ( !$$cl->{"err"}) {
673 # Command does not contain mistakes
675 my %commands = extract_from_cline("commands", ${$cl}->{"cline"});
676 my %files = extract_from_cline("files", ${$cl}->{"cline"});
678 # Searching for new commands only
679 for my $command (keys %commands) {
680 if (!defined $Commands_Stat{$command}) {
681 push @{$$cl->{new_commands}}, $command;
682 }
683 $Commands_Stat{$command}++;
684 }
686 for my $file (keys %files) {
687 if (!defined $Files_Stat{$file}) {
688 push @{$$cl->{new_files}}, $file;
689 }
690 $Files_Stat{$file}++;
691 }
692 }
693 }
695 }
698 =cut
699 Вывести результат обработки журнала.
700 =cut
703 sub print_command_lines
704 {
705 my $output_filename=$_[0];
706 my $mode = ">";
707 $mode =">>" if $Config{mode} eq "daemon";
708 open(OUT, $mode, $output_filename)
709 or die "Can't open $output_filename for writing\n";
713 #print OUT "<livelablog>\n";
715 my $cl;
716 my $in_range=0;
717 for my $i (@Command_Lines_Index) {
718 $cl = $Command_Lines[$i];
720 if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {
721 $in_range=1;
722 next;
723 }
724 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
725 $in_range=0;
726 next;
727 }
728 next if ($Config{"from"} && $Config{"to"} && !$in_range)
729 ||
730 ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )
731 ||
732 ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)
733 ||
734 ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);
736 my @new_commands=@{$cl->{"new_commands"}};
737 my @new_files=@{$cl->{"new_files"}};
739 my $cl_class="cline";
740 my $out_class="output";
741 if ($cl->{"class"}) {
742 $cl_class = $cl->{"class"}."_".$cl_class;
743 $out_class = $cl->{"class"}."_".$out_class;
744 }
746 # Вырезаем из вывода только нужное количество строк
748 my $output="";
749 if ($Config{"head_lines"} || $Config{"tail_lines"}) {
750 # Partialy output
751 my @lines = split '\n', $cl->{"output"};
752 # head
753 my $mark=1;
754 for (my $i=0; $i<= $#lines && $i < $Config{"cache_head_lines"}; $i++) {
755 $output .= $lines[$i]."\n";
756 }
757 # tail
758 my $start=$#lines-$Config{"cache_tail_lines"}+1;
759 if ($start < 0) {
760 $start=0;
761 $mark=0;
762 }
763 if ($start < $Config{"cache_head_lines"}) {
764 $start=$Config{"cache_head_lines"};
765 $mark=0;
766 }
767 $output .= $Config{"skip_text"}."\n" if $mark;
768 for (my $i=$start; $i<= $#lines; $i++) {
769 $output .= $lines[$i]."\n";
770 }
771 }
772 else {
773 # Full output
774 $output .= $cl->{"output"};
775 }
776 $output .= "^C\n" if ($cl->{"err"} eq "130");
779 # Совместимость с labmaker
781 # Переводим в секунды Эпохи
782 # В labmaker'е данные хранились в неудобной форме: hour, min, sec, day of year
783 # Информация о годе отсутствовала
784 # Её можно внести:
785 # Декабрь 2004 год; остальные -- 2005 год.
787 my $year = 2005;
788 $year = 2004 if ( $cl->{day} > 330 );
789 # timelocal( $sec, $min, $hour, $mday,$mon,$year);
790 $cl->{time} = timelocal_nocheck($cl->{sec},$cl->{min},$cl->{hour},$cl->{day},0,$year);
793 # Начинаем вывод команды
794 print OUT "<command>\n";
795 print OUT "<local_session_id>",$cl->{session_id},"</local_session_id>\n";
796 print OUT "<time>",$cl->{time},"</time>\n";
797 print OUT "<raw_start>",$cl->{raw_start},"</raw_start>\n";
798 print OUT "<raw_output_start>",$cl->{raw_output_start},"</raw_output_start>\n";
799 print OUT "<raw_end>",$cl->{raw_end},"</raw_end>\n";
800 print OUT "<raw_file>",$cl->{raw_file},"</raw_file>\n";
801 print OUT "<tty>",$cl->{tty},"</tty>\n";
802 print OUT "<out_class>",$out_class,"</out_class>\n";
803 print OUT "<prompt>";
804 printq(\*OUT,,$cl->{"prompt"});
805 print OUT "</prompt>";
806 print OUT "<cline>";
807 printq(\*OUT,$cl->{"cline"});
808 print OUT "</cline>\n";
809 print OUT "<last_command>",$cl->{"last_command"},"</last_command>\n";
810 if (@new_commands) {
811 print OUT "<new_commands>";
812 printq(\*OUT, join (" ", @new_commands));
813 print OUT "</new_commands>";
814 }
815 if (@new_files) {
816 print OUT "<new_files>";
817 printq(\*OUT, join (" ", @new_files));
818 print OUT "</new_files>";
819 }
820 print OUT "<output>";
821 printq(\*OUT,$output);
822 print OUT "</output>\n";
823 if ($cl->{"diff"}) {
824 print OUT "<diff>";
825 printq(\*OUT,${$Diffs{$cl->{"diff"}}}{"text"});
826 print OUT "</diff>\n";
827 }
828 print OUT "</command>\n";
830 }
832 #print OUT "</livelablog>\n";
833 close(OUT);
834 }
836 sub print_session
837 {
838 my $output_filename = $_[0];
839 my $local_session_id = $_[1];
840 return if not defined($Sessions{$local_session_id});
842 open(OUT, ">>", $output_filename)
843 or die "Can't open $output_filename for writing\n";
844 print OUT "<session>\n";
845 my %session = %{$Sessions{$local_session_id}};
846 for my $key (keys %session) {
847 print OUT "<$key>".$session{$key}."</$key>\n"
848 }
849 print OUT "</session>\n";
850 close(OUT);
851 }
853 sub send_cache
854 {
855 # Если в кэше что-то накопилось,
856 # попытаемся отправить это на сервер
857 #
858 my $cache_was_sent=0;
860 if (open(CACHE, $Config{cache})) {
861 local $/;
862 my $cache = <CACHE>;
863 close(CACHE);
865 my $socket = IO::Socket::INET->new(
866 PeerAddr => $Config{backend_address},
867 PeerPort => $Config{backend_port},
868 proto => "tcp",
869 Type => SOCK_STREAM
870 );
872 if ($socket) {
873 print $socket $cache;
874 close($socket);
875 $cache_was_sent = 1;
876 }
877 }
878 return $cache_was_sent;
879 }
881 sub save_cache_stat
882 {
883 open (CACHE, ">$Config{cache_stat}");
884 for my $f (keys %Script_Files) {
885 print CACHE "$f\t",$Script_Files{$f}->{size},"\t",$Script_Files{$f}->{tell},"\n";
886 }
887 close(CACHE);
888 }
890 sub load_cache_stat
891 {
892 if (open (CACHE, "$Config{cache_stat}")) {
893 while(<CACHE>) {
894 chomp;
895 my ($f, $size, $tell) = split /\t/;
896 $Script_Files{$f}->{size} = $size;
897 $Script_Files{$f}->{tell} = $tell;
898 }
899 close(CACHE);
900 };
901 }
904 main();
906 sub process_was_killed
907 {
908 $Killed = 1;
909 }
911 sub main
912 {
914 $| = 1;
916 init_variables();
917 init_config();
920 if ($Config{"mode"} ne "daemon") {
922 =cut
923 В нормальном режиме работы нужно
924 считать скрипты, обработать их и записать
925 результат выполнения в результриующий файл.
926 После этого завершить работу.
927 =cut
928 for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) {
929 load_diff_files($lab_log);
930 }
931 load_command_lines($Config{"input"}, $Config{"input_mask"});
932 sort_command_lines;
933 process_command_lines;
934 print_command_lines($Config{"cache"});
935 }
936 else {
937 if (open(PIDFILE, $Config{agent_pidfile})) {
938 my $pid = <PIDFILE>;
939 close(PIDFILE);
940 if ( ! -e "/proc/$pid" || !`grep $Config{"l3-agent"} /proc/$pid/cmdline && grep "uid:.*\b$<\b" /proc/$pid/status`) {
941 print "Removing stale pidfile\n";
942 unlink $Config{agent_pidfile}
943 or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!";
944 }
945 else {
946 print "l3-agent is already running\n";
947 exit(0);
948 }
949 }
950 if ($Config{detach} =~ /^y/i) {
951 #$Config{verbose} = "no";
952 my $pid = fork;
953 exit if $pid;
954 die "Couldn't fork: $!" unless defined ($pid);
956 open(PIDFILE, ">", $Config{agent_pidfile})
957 or die "Can't open pidfile ". $Config{agent_pidfile}. " for wrting: $!";
958 print PIDFILE $$;
959 close(PIDFILE);
961 for my $handle (*STDIN, *STDOUT, *STDERR) {
962 open ($handle, "+<", "/dev/null")
963 or die "can't reopen $handle to /dev/null: $!"
964 }
966 POSIX::setsid()
967 or die "Can't start a new session: $!";
969 $0 = $Config{"l3-agent"};
971 $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&process_was_killed;
972 }
973 while (not $Killed) {
974 @Command_Lines = ();
975 @Command_Lines_Index = ();
976 for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) {
977 load_diff_files($lab_log);
978 }
979 load_cache_stat();
980 load_command_lines($Config{"input"}, $Config{"input_mask"});
981 if (@Command_Lines) {
982 sort_command_lines;
983 process_command_lines;
984 print_command_lines($Config{"cache"});
985 }
986 save_cache_stat();
987 if (-e $Config{cache} && (stat($Config{cache}))[7]) {
988 send_cache() && unlink($Config{cache});
989 }
990 sleep($Config{"daemon_sleep_interval"} || 1);
991 }
993 unlink $Config{agent_pidfile};
994 }
996 }
998 sub init_variables
999 {
1000 }