lilalo
view l3-agent @ 32:4d252e7dd478
l3-frontend:
Добавлена поддержка фильтрации по пользователю (user) и хосту (hostname).
Пока только прототип - нужно оптимизировать.
И нужно стандартизировать имена для полей
l3-cgi:
В current теперь могут быть подразделы
Добавлена поддержка фильтрации по пользователю (user) и хосту (hostname).
Пока только прототип - нужно оптимизировать.
И нужно стандартизировать имена для полей
l3-cgi:
В current теперь могут быть подразделы
| author | devi |
|---|---|
| date | Mon Nov 14 07:42:57 2005 +0200 (2005-11-14) |
| parents | 196c82b6e538 |
| children | 219389279acb |
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 "<prompt>";
813 printq(\*OUT,,$cl->{"prompt"});
814 print OUT "</prompt>";
815 print OUT "<cline>";
816 printq(\*OUT,$cl->{"cline"});
817 print OUT "</cline>\n";
818 print OUT "<last_command>",$cl->{"last_command"},"</last_command>\n";
819 if (@new_commands) {
820 print OUT "<new_commands>";
821 printq(\*OUT, join (" ", @new_commands));
822 print OUT "</new_commands>";
823 }
824 if (@new_files) {
825 print OUT "<new_files>";
826 printq(\*OUT, join (" ", @new_files));
827 print OUT "</new_files>";
828 }
829 print OUT "<output>";
830 printq(\*OUT,$output);
831 print OUT "</output>\n";
832 if ($cl->{"diff"}) {
833 print OUT "<diff>";
834 printq(\*OUT,${$Diffs{$cl->{"diff"}}}{"text"});
835 print OUT "</diff>\n";
836 }
837 if ($cl->{"note"}) {
838 print OUT "<note>";
839 printq(\*OUT,$cl->{"note"});
840 print OUT "</note>\n";
841 }
842 if ($cl->{"note_title"}) {
843 print OUT "<note_title>";
844 printq(\*OUT,$cl->{"note_title"});
845 print OUT "</note_title>\n";
846 }
847 print OUT "</command>\n";
849 }
851 #print OUT "</livelablog>\n";
852 close(OUT);
853 }
855 sub print_session
856 {
857 my $output_filename = $_[0];
858 my $local_session_id = $_[1];
859 return if not defined($Sessions{$local_session_id});
861 open(OUT, ">>", $output_filename)
862 or die "Can't open $output_filename for writing\n";
863 print OUT "<session>\n";
864 my %session = %{$Sessions{$local_session_id}};
865 for my $key (keys %session) {
866 print OUT "<$key>".$session{$key}."</$key>\n"
867 }
868 print OUT "</session>\n";
869 close(OUT);
870 }
872 sub send_cache
873 {
874 # Если в кэше что-то накопилось,
875 # попытаемся отправить это на сервер
876 #
877 my $cache_was_sent=0;
879 if (open(CACHE, $Config{cache})) {
880 local $/;
881 my $cache = <CACHE>;
882 close(CACHE);
884 my $socket = IO::Socket::INET->new(
885 PeerAddr => $Config{backend_address},
886 PeerPort => $Config{backend_port},
887 proto => "tcp",
888 Type => SOCK_STREAM
889 );
891 if ($socket) {
892 print $socket $cache;
893 close($socket);
894 $cache_was_sent = 1;
895 }
896 }
897 return $cache_was_sent;
898 }
900 sub save_cache_stat
901 {
902 open (CACHE, ">$Config{cache_stat}");
903 for my $f (keys %Script_Files) {
904 print CACHE "$f\t",$Script_Files{$f}->{size},"\t",$Script_Files{$f}->{tell},"\n";
905 }
906 close(CACHE);
907 }
909 sub load_cache_stat
910 {
911 if (open (CACHE, "$Config{cache_stat}")) {
912 while(<CACHE>) {
913 chomp;
914 my ($f, $size, $tell) = split /\t/;
915 $Script_Files{$f}->{size} = $size;
916 $Script_Files{$f}->{tell} = $tell;
917 }
918 close(CACHE);
919 };
920 }
923 main();
925 sub process_was_killed
926 {
927 $Killed = 1;
928 }
930 sub main
931 {
933 $| = 1;
935 init_variables();
936 init_config();
939 if ($Config{"mode"} ne "daemon") {
941 =cut
942 В нормальном режиме работы нужно
943 считать скрипты, обработать их и записать
944 результат выполнения в результриующий файл.
945 После этого завершить работу.
946 =cut
947 for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) {
948 load_diff_files($lab_log);
949 }
950 load_command_lines($Config{"input"}, $Config{"input_mask"});
951 sort_command_lines;
952 process_command_lines;
953 print_command_lines($Config{"cache"});
954 }
955 else {
956 if (open(PIDFILE, $Config{agent_pidfile})) {
957 my $pid = <PIDFILE>;
958 close(PIDFILE);
959 if ( ! -e "/proc/$pid" || !`grep $Config{"l3-agent"} /proc/$pid/cmdline && grep "uid:.*\b$<\b" /proc/$pid/status`) {
960 print "Removing stale pidfile\n";
961 unlink $Config{agent_pidfile}
962 or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!";
963 }
964 else {
965 print "l3-agent is already running\n";
966 exit(0);
967 }
968 }
969 if ($Config{detach} =~ /^y/i) {
970 #$Config{verbose} = "no";
971 my $pid = fork;
972 exit if $pid;
973 die "Couldn't fork: $!" unless defined ($pid);
975 open(PIDFILE, ">", $Config{agent_pidfile})
976 or die "Can't open pidfile ". $Config{agent_pidfile}. " for wrting: $!";
977 print PIDFILE $$;
978 close(PIDFILE);
980 for my $handle (*STDIN, *STDOUT, *STDERR) {
981 open ($handle, "+<", "/dev/null")
982 or die "can't reopen $handle to /dev/null: $!"
983 }
985 POSIX::setsid()
986 or die "Can't start a new session: $!";
988 $0 = $Config{"l3-agent"};
990 $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&process_was_killed;
991 }
992 while (not $Killed) {
993 @Command_Lines = ();
994 @Command_Lines_Index = ();
995 for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) {
996 load_diff_files($lab_log);
997 }
998 load_cache_stat();
999 load_command_lines($Config{"input"}, $Config{"input_mask"});
1000 if (@Command_Lines) {
1001 sort_command_lines;
1002 process_command_lines;
1003 print_command_lines($Config{"cache"});
1004 }
1005 save_cache_stat();
1006 if (-e $Config{cache} && (stat($Config{cache}))[7]) {
1007 send_cache() && unlink($Config{cache});
1008 }
1009 sleep($Config{"daemon_sleep_interval"} || 1);
1010 }
1012 unlink $Config{agent_pidfile};
1013 }
1015 }
1017 sub init_variables
1018 {
1019 }