lilalo

view l3-agent @ 26:916661a89335

Написал что нового в 0.2.3
author devi
date Thu Nov 03 17:53:03 2005 +0200 (2005-11-03)
parents 6d93c5f1d0e5
children 098664cf339c
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';
14 use lib ".";
15 use l3config;
18 our @Command_Lines;
19 our @Command_Lines_Index;
20 our @Diffs;
22 our %Commands_Stat; # Statistics about commands usage
23 our %Files_Stat; # Statistics about commands usage
25 our %Script_Files; # Информация о позициях в скрипт-файлах,
26 # до которых уже выполнен разбор
27 # и информация о времени модификации файла
28 # $Script_Files{$file}->{size}
29 # $Script_Files{$file}->{tell}
31 our $Killed =0; # В режиме демона -- процесс получил сигнал о завершении
33 sub init_variables;
34 sub main;
36 sub load_diff_files;
37 sub bind_diff;
38 sub extract_from_cline;
39 sub load_command_lines;
40 sub sort_command_lines;
41 sub process_command_lines;
42 sub print_command_lines;
43 sub printq;
45 sub save_cache_stat;
46 sub load_cache_stat;
49 sub load_diff_files
50 {
51 my @pathes = @_;
53 for my $path (@pathes) {
54 my $template = "*.diff";
55 my @files = <$path/$template>;
56 my $i=0;
57 for my $file (@files) {
58 my %diff;
60 $diff{"path"}=$path;
61 $diff{"uid"}="SET THIS";
63 # Сейчас UID определяется из названия каталога
64 # откуда берутся diff-файлы
65 # Это неправильно
66 #
67 # ВАРИАНТ:
68 # К файлам жураналам должны прилагаться ситемны файлы,
69 # мз которых и будет определяться соответствие
70 # имён пользователей их uid'ам
71 #
72 $diff{"uid"} = 0 if $path =~ m@/root/@;
74 $diff{"bind_to"}="";
75 $diff{"time_range"}=-1;
77 next if not $file=~m@/(D?[0-9][0-9]?[0-9]?)[^/]*?([0-9]*):([0-9]*):?([0-9]*)@;
78 $diff{"day"}=$1 || "";
79 $diff{"hour"}=$2;
80 $diff{"min"}=$3;
81 $diff{"sec"}=$4 || 0;
83 $diff{"index"}=$i;
85 print "diff loaded: $diff{day} $diff{hour}:$diff{min}:$diff{sec}\n";
87 local $/;
88 open (F, "$file")
89 or return "Can't open file $file ($_[0]) for reading";
90 my $text = <F>;
91 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i) {
92 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8");
93 $text = $converter->convert($text);
94 }
95 close(F);
96 $diff{"text"}=$text;
97 #print "$file loaded ($diff{day})\n";
99 push @Diffs, \%diff;
100 $i++;
101 }
102 }
103 }
106 sub bind_diff
107 {
108 # my $path = shift;
109 # my $pid = shift;
110 # my $day = shift;
111 # my $lab = shift;
113 print "Trying to bind diff...\n";
115 my $cl = shift;
116 my $hour = $cl->{"hour"};
117 my $min = $cl->{"min"};
118 my $sec = $cl->{"sec"};
120 my $min_dt = 10000;
122 for my $diff (@Diffs) {
123 # Check here date, time and user
124 next if ($diff->{"day"} && $cl->{"day"} && ($cl->{"day"} ne $diff->{"day"}));
125 #next if (!$diff->{"uid"} && $cl->{"euid"} != $diff->{"uid"});
127 my $dt=($diff->{"hour"}-$hour)*3600 +($diff->{"min"}-$min)*60 + ($diff->{"sec"}-$sec);
128 if ($dt >0 && $dt < $min_dt && ($diff->{"time_range"} <0 || $dt < $diff->{"time_range"})) {
129 print "Approppriate diff found: dt=$dt\n";
130 if ($diff->{"bind_to"}) {
131 undef $diff->{"bind_to"}->{"diff"};
132 };
133 $diff->{"time_range"}=$dt;
134 $diff->{"bind_to"}=$cl;
136 $cl->{"diff"} = $diff->{"index"};
137 $min_dt = $dt;
138 }
140 }
141 }
144 sub extract_from_cline
145 # Разобрать командную строку $_[1] и возвратить хэш, содержащий
146 # номер первого появление команды в строке:
147 # команда => первая позиция
148 {
149 my $what = $_[0];
150 my $cline = $_[1];
151 my @lists = split /\;/, $cline;
154 my @commands = ();
155 for my $list (@lists) {
156 push @commands, split /\|/, $list;
157 }
159 my %commands;
160 my %files;
161 my $i=0;
162 for my $command (@commands) {
163 $command =~ /\s*(\S+)\s*(.*)/;
164 if ($1 && $1 eq "sudo" ) {
165 $commands{"$1"}=$i++;
166 $command =~ s/\s*sudo\s+//;
167 }
168 $command =~ /\s*(\S+)\s*(.*)/;
169 if ($1 && !defined $commands{"$1"}) {
170 $commands{"$1"}=$i++;
171 };
172 if ($2) {
173 my $args = $2;
174 my @args = split (/\s+/, $args);
175 for my $a (@args) {
176 $files{"$a"}=$i++
177 if !defined $files{"$a"};
178 };
181 }
182 }
184 if ($what eq "commands") {
185 return %commands;
186 } else {
187 return %files;
188 }
190 }
192 sub load_command_lines
193 {
194 my $lab_scripts_path = $_[0];
195 my $lab_scripts_mask = $_[1];
197 my $cline_re_base = qq'
198 (
199 (?:\\^?([0-9]*C?)) # exitcode
200 (?:_([0-9]+)_)? # uid
201 (?:_([0-9]+)_) # pid
202 (...?) # day
203 (.?.?) # lab
204 \\s # space separator
205 ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) # time
206 .\\[50D.\\[K # killing symbols
207 (.*?([\$\#]\\s?)) # prompt
208 (.*) # command line
209 )
210 ';
211 #my $cline_re = qr/$cline_re_base(?:$cline_re_base|$)/x;
212 #my $cline_re = qr/(?:$cline_re_base)*$cline_re_base$/x;
213 my $cline_re = qr/$cline_re_base/sx;
214 my $cline_re1 = qr/$cline_re_base\x0D/sx;
215 my $cline_re2 = qr/$cline_re_base$/sx;
217 my $vt = Term::VT102->new ( 'cols' => $Config{"terminal_width"},
218 'rows' => $Config{"terminal_height"});
219 my $cline_vt = Term::VT102->new ('cols' => $Config{"terminal_width"},
220 'rows' => $Config{"terminal_height"});
222 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8")
223 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i);
225 print "Loading lm-scripts...\n" if $Config{"verbose"} =~ /y/;
227 my @lab_scripts = <$lab_scripts_path/$lab_scripts_mask>;
228 my $file;
229 my $files_number = $#lab_scripts;
230 my $ii = 0;
231 my $skip_info;
233 my $commandlines_loaded =0;
234 my $commandlines_processed =0;
236 for $file (@lab_scripts){
237 #printf "\t%i %3.2f\n", $ii, (100*$ii++/$files_number) if $Config{"verbose"} =~ /y/;
239 # Пропускаем файл, если он не изменялся со времени нашего предудущего прохода
240 my $size = (stat($file))[7];
241 next if ($Script_Files{$file} && $Script_Files{$file}->{size} && $Script_Files{$file}->{size} >= $size);
243 open (FILE, "$file");
244 binmode FILE;
246 # Переходим к тому месту, где мы окончили разбор
247 seek (FILE, $Script_Files{$file}->{tell}, 0) if $Script_Files{$file}->{tell};
248 $Script_Files{$file}->{size} = $size;
249 $Script_Files{$file}->{tell} = 0 unless $Script_Files{$file}->{tell};
252 $file =~ m@.*/(.*?)-.*@;
254 my $tty = $1;
255 my $first_pass = 1;
256 my %cl;
257 my $last_output_length=0;
258 while (<FILE>) {
260 $commandlines_processed++;
261 # time
263 if (/[0-9][0-9]:[0-9][0-9]:[0-9][0-9].\[[0-9][0-9]D.\[K/ && m/$cline_re/) {
264 s/.*\x0d(?!\x0a)//;
265 # print "!!!",$_,"!!!\n";
266 # next;
267 # while (m/$cline_re1/gs) {
268 # }
269 m/$cline_re2/gs;
271 $commandlines_loaded++;
272 $last_output_length=0;
274 # Previous command
275 my %last_cl = %cl;
276 my $err = $2 || "";
279 =cut
281 ТАБЛИЦА КОМАНД
283 uid
284 Идентификатор пользователя
286 tty
287 Идентификатор терминала, на котором была вызвана команда
289 pid
290 PID-процесса командного интерпретатора,
291 в котором была вызвана команда
293 lab
294 лабораторная работа, к которой относится команда.
295 Идентификатор текущей лабораторной работы
296 хранится в файле ~/.labmaker/lab
298 pwd (!)
299 текущий каталог, из которого была вызвана команда
301 day
302 время вызова, день
303 В действительности здесь хранится не время вызова команды,
304 а с момента появления приглашения командного интерпретатора
305 для ввода команды
308 hour
309 время вызова, час
311 min
312 время вызова, минута
314 sec
315 время вызова, секунда
317 time (!)
318 время вызова команды в Unix-формате.
319 Предпочтительнее использовать этот формат чем hour:min:sec,
320 использовавшийся в Labmaker
322 fullprompt
323 Приглашение командной строки
325 prompt
326 Сокращённое приглашение командной строки
328 cline
329 Командная строка
331 output
332 Результат выполнения команды
334 diff
335 Указатель на ассоциированный с командой diff
337 note (!)
338 Текстовый комментарий к команде.
339 Может генерироваться из самого лога с помощью команд
340 #^ Комментарий
341 #v Комментарий
342 в том случае, если для комментирования достаточно одной строки,
343 или с помощью команд
344 cat > /dev/null #^ Заголовок
345 Текст
346 ^D
347 в том случае, если комментарий развёрнутый.
348 В последнем случае комментарий может содержать
349 заголовок, абзацы и несложное форматирование.
351 Символ ^ или v после знака комментария # обозначает,
352 к какой команде относится комментарий:
353 к предыдущей (^) или последующей (v)
355 err
356 Код завершения командной строки
358 histnum (!)
359 Номер команды в истории командного интерпретатора
361 status (!)
362 Является ли данная команда вызванной (r), запомненной (s)
363 или это подсказка completion (c).
365 Команды, которые были вызваны и обработаны интерпретатором
366 имеют состояние "r". К таким командам относится большинство
367 команд вводимых в интерпретатор.
369 Если команда набрана, но вызывать её по какой-либо причине
370 не хочется (например, команда может быть не полной, вредоносной
371 или просто бессмысленной в текущих условиях),
372 её можно сбросить с помощью комбинации клавиш Ctrl-C
373 (не путайте с прерыванием работающей команды! здесь она даже
374 не запускается!).
375 В таком случае она не выполняется, но попадает в журнал
376 со статусом "s".
378 Если команда появилась в журнале благодаря автопроолжению
379 -- когда было показано несколько вариантов --
380 она имеет статус "c".
382 euid
383 Идентификатор пользователя от имени которого будет
384 выполняться команда.
385 Может отличаться от реального uid в том случае,
386 если вызывается с помощью sudo
389 version (!)
390 Версия lilalo-prompt использовавшаяся при записи
391 команды.
393 0 - версия использовавшая в labmaker.
394 Отсутствует информация о текущем каталоге и номере в истории.
395 Информация о версии также не указана в приглашении.
398 1 - версия использующаяся в lilalo
400 raw_file (*)
401 Имя файла, в котором находится бинарное представление журнала.
402 Может содержать ключевое слово HERE,
403 обозначающее что бинарное представление хранится
404 непосредственно в базе данных в атрибуте raw_data
406 raw_start (*)
407 Начало блока командной строки в файле бинарного представления
409 raw_output_start (*)
410 Начало блока вывода
412 raw_end (*)
413 Конец блока командной строки в файле бинарного представления
415 raw_cline (*)
416 Необработанная командная строка (без приглашения) в бинарном виде
418 raw_data (*)
419 Бинарное представление команды и результатов её выполнения
424 ТАБЛИЦА SESSION
426 Информация о сеансах
431 =cut
433 # Parse new command
434 $cl{"uid"} = $3;
435 $cl{"euid"} = $cl{"uid"}; # Если в команде обнаружится sudo, euid поменяем на 0
436 $cl{"pid"} = $4;
437 $cl{"day"} = $5;
438 $cl{"lab"} = $6;
439 $cl{"hour"} = $7;
440 $cl{"min"} = $8;
441 $cl{"sec"} = $9;
442 $cl{"fullprompt"} = $10;
443 $cl{"prompt"} = $11;
444 $cl{"raw_cline"} = $12;
446 {
447 use bytes;
448 $cl{"raw_start"} = tell (FILE) - length($1);
449 $cl{"raw_output_start"} = tell FILE;
450 }
451 $cl{"raw_file"} = $file;
453 $cl{"err"} = 0;
454 $cl{"output"} = "";
455 $cl{"tty"} = $tty;
457 $cline_vt->process($cl{"raw_cline"}."\n");
458 $cl{"cline"} = $cline_vt->row_plaintext (1);
459 $cl{"cline"} =~ s/\s*$//;
460 $cline_vt->reset();
462 my %commands = extract_from_cline("commands", $cl{"cline"});
463 $cl{"euid"}=0 if defined $commands{"sudo"};
464 my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands;
465 $cl{"last_command"} = $comms[$#comms] || "";
467 if (
468 $Config{"suppress_editors"} =~ /^y/i
469 && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}}) ||
470 $Config{"suppress_pagers"} =~ /^y/i
471 && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}}) ||
472 $Config{"suppress_terminal"}=~ /^y/i
473 && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}})
474 ) {
475 $cl{"suppress_output"} = "1";
476 }
477 else {
478 $cl{"suppress_output"} = "0";
480 }
481 $skip_info = 0;
484 print " ",$cl{"last_command"};
486 # Processing previous command line
487 if ($first_pass) {
488 $first_pass = 0;
489 next;
490 }
492 # Error code
493 $last_cl{"raw_end"} = $cl{"raw_start"};
494 $last_cl{"err"}=$err;
495 $last_cl{"err"}=130 if $err eq "^C";
497 if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) {
498 bind_diff(\%last_cl);
499 }
501 # Output
502 if (!$last_cl{"suppress_output"} || $last_cl{"err"}) {
503 for (my $i=0; $i<$Config{"terminal_height"}; $i++) {
504 my $line= $vt->row_plaintext($i);
505 next if !defined ($line) || $line =~ /^\s*$/;
506 $line =~ s/\s*$//;
507 $last_cl{"output"} .= $line."\n";
508 }
509 }
510 else {
511 $last_cl{"output"}= "";
512 }
514 $vt->reset();
517 # Classifying the command line
520 # Save
521 if (!$Config{"lab"} || $cl{"lab"} eq $Config{"lab"}) {
522 # Changing encoding
523 for (keys %last_cl) {
524 next if /raw/;
525 $last_cl{$_} = $converter->convert($last_cl{$_})
526 if ($Config{"encoding"} &&
527 $Config{"encoding"} !~ /^utf-8$/i);
528 }
529 push @Command_Lines, \%last_cl;
531 # Сохранение позиции в файле, до которой выполнен
532 # успешный разбор
533 $Script_Files{$file}->{tell} = $last_cl{raw_end};
534 }
535 next;
536 }
537 $last_output_length+=length($_);
538 #if (!$cl{"suppress_output"} || $last_output_length < 5000) {
539 if ($last_output_length < 50000) {
540 #print "(",length($_),")" if (length($_) > 2000) ;
541 $vt->process("$_"."\n")
542 }
543 else
544 {
545 if (!$skip_info) {
546 print "($cl{last_command})";
547 $skip_info = 1;
548 }
549 }
550 }
551 close(FILE);
553 }
554 if ($Config{"verbose"} =~ /y/) {
555 print "...finished." ;
556 print "Lines loaded: $commandlines_processed\n";
557 print "Command lines: $commandlines_loaded\n";
558 }
559 }
563 sub printq
564 {
565 my $TO = shift;
566 my $text = join "", @_;
567 $text =~ s/&/&amp;/g;
568 $text =~ s/</&lt;/g;
569 $text =~ s/>/&gt;/g;
570 print $TO $text;
571 }
574 sub sort_command_lines
575 {
576 print "Sorting command lines...\n" if $Config{"verbose"} =~ /y/;
578 # Sort Command_Lines
579 # Write Command_Lines to Command_Lines_Index
581 my @index;
582 for (my $i=0;$i<=$#Command_Lines;$i++) {
583 $index[$i]=$i;
584 }
586 @Command_Lines_Index = sort {
587 $Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"} ||
588 $Command_Lines[$index[$a]]->{"hour"} <=> $Command_Lines[$index[$b]]->{"hour"} ||
589 $Command_Lines[$index[$a]]->{"min"} <=> $Command_Lines[$index[$b]]->{"min"} ||
590 $Command_Lines[$index[$a]]->{"sec"} <=> $Command_Lines[$index[$b]]->{"sec"}
591 } @index;
593 print "...finished\n" if $Config{"verbose"} =~ /y/;
595 }
597 sub process_command_lines
598 {
599 for my $i (@Command_Lines_Index) {
601 my $cl = \$Command_Lines[$i];
602 @{${$cl}->{"new_commands"}} =();
603 @{${$cl}->{"new_files"}} =();
604 $$cl->{"class"} = "";
606 if ($$cl->{"err"}) {
607 $$cl->{"class"}="wrong";
608 $$cl->{"class"}="interrupted"
609 if ($$cl->{"err"} eq 130);
610 }
611 if (!$$cl->{"euid"}) {
612 $$cl->{"class"}.="_root";
613 }
615 #tab# my @tab_words=split /\s+/, $$cl->{"output"};
616 #tab# my $last_word= $$cl->{"cline"} =~ /(\S*)$/;
617 #tab# $last_word =~ s@.*/@@;
618 #tab# my $this_is_tab=1;
619 #tab#
620 #tab# if ($last_word && @tab_words >2) {
621 #tab# for my $tab_words (@tab_words) {
622 #tab# if ($tab_words !~ /^$last_word/) {
623 #tab# $this_is_tab=0;
624 #tab# last;
625 #tab# }
626 #tab# }
627 #tab# }
628 #tab# $$cl->{"class"}="tab" if $this_is_tab;
631 if ( !$$cl->{"err"}) {
632 # Command does not contain mistakes
634 my %commands = extract_from_cline("commands", ${$cl}->{"cline"});
635 my %files = extract_from_cline("files", ${$cl}->{"cline"});
637 # Searching for new commands only
638 for my $command (keys %commands) {
639 if (!defined $Commands_Stat{$command}) {
640 push @{$$cl->{new_commands}}, $command;
641 }
642 $Commands_Stat{$command}++;
643 }
645 for my $file (keys %files) {
646 if (!defined $Files_Stat{$file}) {
647 push @{$$cl->{new_files}}, $file;
648 }
649 $Files_Stat{$file}++;
650 }
651 }
652 }
654 }
657 =cut
658 Вывести результат обработки журнала.
659 =cut
662 sub print_command_lines
663 {
664 my $output_filename=$_[0];
665 my $mode = ">";
666 $mode =">>" if $Config{mode} eq "daemon";
667 open(OUT, $mode, $output_filename)
668 or die "Can't open $output_filename for writing\n";
672 #print OUT "<livelablog>\n";
674 my $cl;
675 my $in_range=0;
676 for my $i (@Command_Lines_Index) {
677 $cl = $Command_Lines[$i];
679 if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {
680 $in_range=1;
681 next;
682 }
683 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
684 $in_range=0;
685 next;
686 }
687 next if ($Config{"from"} && $Config{"to"} && !$in_range)
688 ||
689 ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )
690 ||
691 ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)
692 ||
693 ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);
695 my @new_commands=@{$cl->{"new_commands"}};
696 my @new_files=@{$cl->{"new_files"}};
698 my $cl_class="cline";
699 my $out_class="output";
700 if ($cl->{"class"}) {
701 $cl_class = $cl->{"class"}."_".$cl_class;
702 $out_class = $cl->{"class"}."_".$out_class;
703 }
705 # Вырезаем из вывода только нужное количество строк
707 my $output="";
708 if ($Config{"head_lines"} || $Config{"tail_lines"}) {
709 # Partialy output
710 my @lines = split '\n', $cl->{"output"};
711 # head
712 my $mark=1;
713 for (my $i=0; $i<= $#lines && $i < $Config{"cache_head_lines"}; $i++) {
714 $output .= $lines[$i]."\n";
715 }
716 # tail
717 my $start=$#lines-$Config{"cache_tail_lines"}+1;
718 if ($start < 0) {
719 $start=0;
720 $mark=0;
721 }
722 if ($start < $Config{"cache_head_lines"}) {
723 $start=$Config{"cache_head_lines"};
724 $mark=0;
725 }
726 $output .= $Config{"skip_text"}."\n" if $mark;
727 for (my $i=$start; $i<= $#lines; $i++) {
728 $output .= $lines[$i]."\n";
729 }
730 }
731 else {
732 # Full output
733 $output .= $cl->{"output"};
734 }
735 $output .= "^C\n" if ($cl->{"err"} eq "130");
738 # Совместимость с labmaker
740 # Переводим в секунды Эпохи
741 # В labmaker'е данные хранились в неудобной форме: hour, min, sec, day of year
742 # Информация о годе отсутствовала
743 # Её можно внести:
744 # Декабрь 2004 год; остальные -- 2005 год.
746 my $year = 2005;
747 $year = 2004 if ( $cl->{day} > 330 );
748 # timelocal( $sec, $min, $hour, $mday,$mon,$year);
749 $cl->{time} = timelocal_nocheck($cl->{sec},$cl->{min},$cl->{hour},$cl->{day},0,$year);
752 # Начинаем вывод команды
753 print OUT "<command>\n";
754 print OUT "<time>",$cl->{time},"</time>\n";
755 print OUT "<raw_start>",$cl->{raw_start},"</raw_start>\n";
756 print OUT "<raw_output_start>",$cl->{raw_output_start},"</raw_output_start>\n";
757 print OUT "<raw_end>",$cl->{raw_end},"</raw_end>\n";
758 print OUT "<raw_file>",$cl->{raw_file},"</raw_file>\n";
759 print OUT "<tty>",$cl->{tty},"</tty>\n";
760 print OUT "<out_class>",$out_class,"</out_class>\n";
761 print OUT "<prompt>";
762 printq(\*OUT,,$cl->{"prompt"});
763 print OUT "</prompt>";
764 print OUT "<cline>";
765 printq(\*OUT,$cl->{"cline"});
766 print OUT "</cline>\n";
767 print OUT "<last_command>",$cl->{"last_command"},"</last_command>\n";
768 if (@new_commands) {
769 print OUT "<new_commands>";
770 printq(\*OUT, join (" ", @new_commands));
771 print OUT "</new_commands>";
772 }
773 if (@new_files) {
774 print OUT "<new_files>";
775 printq(\*OUT, join (" ", @new_files));
776 print OUT "</new_files>";
777 }
778 print OUT "<output>";
779 printq(\*OUT,$output);
780 print OUT "</output>\n";
781 if ($cl->{"diff"}) {
782 print OUT "<diff>";
783 printq(\*OUT,${$Diffs[$cl->{"diff"}]}{"text"});
784 print OUT "</diff>\n";
785 }
786 print OUT "</command>\n";
788 }
790 #print OUT "</livelablog>\n";
791 close(OUT);
792 save_cache_stat();
793 }
795 sub save_cache_stat
796 {
797 open (CACHE, ">$Config{cache_stat}");
798 for my $f (keys %Script_Files) {
799 print CACHE "$f\t",$Script_Files{$f}->{size},"\t",$Script_Files{$f}->{tell},"\n";
800 }
801 close(CACHE);
802 }
804 sub load_cache_stat
805 {
806 if (open (CACHE, "$Config{cache_stat}")) {
807 while(<CACHE>) {
808 my ($f, $size, $tell) = split /\t/;
809 $Script_Files{$f}->{size} = $size;
810 $Script_Files{$f}->{tell} = $tell;
811 }
812 close(CACHE);
813 };
814 }
816 =cut
817 sub print_command_lines2
818 {
819 my $output_filename=$_[0];
820 open(OUT, ">", $output_filename)
821 or die "Can't open $output_filename for writing\n";
824 print OUT <<OUT;
825 <log>
826 OUT
828 my $cl;
829 for my $i (@Command_Lines_Index) {
832 $cl = $Command_Lines[$i];
835 # Printing out
836 print OUT <<OUT;
837 <command>
838 <day>$cl->{day}</day>
839 <hour>$cl->{hour}</hour>
840 <min>$cl->{min}</min>
841 <sec>$cl->{sec}</sec>
842 <tty>$cl->{tty}</tty>
843 <uid>$cl->{uid}</uid>
844 <euid>$cl->{euid}</euid>
845 <prompt>$cl->{prompt}</prompt>
846 <cline>$cl->{cline}</cline>
847 <status>$cl->{err}</cline>
848 <output>
849 $cl->{output}</output>
850 </command>
851 OUT
852 }
854 for my $diff (@Diffs) {
856 print OUT <<OUT;
857 <diff>
858 <path>$diff->{path}</path>
859 <uid>$diff->{uid}</uid>
860 <day>$diff->{day}</day>
861 <hour>$diff->{hour}</hour>
862 <min>$diff->{min}</min>
863 <sec>$diff->{sec}</sec>
864 <text>
865 $diff->{text}</text>
866 </diff>
867 OUT
868 }
870 print OUT <<OUT;
871 </log>
872 OUT
873 }
874 =cut
876 main();
878 sub process_was_killed
879 {
880 $Killed = 1;
881 }
883 sub main
884 {
885 $| = 1;
887 init_variables();
888 init_config();
890 for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) {
891 load_diff_files($lab_log);
892 }
894 if ($Config{"mode"} ne "daemon") {
895 load_command_lines($Config{"input"}, $Config{"input_mask"});
896 sort_command_lines;
897 process_command_lines;
898 print_command_lines($Config{"cache"});
899 }
900 else {
901 if (open(PIDFILE, $Config{agent_pidfile})) {
902 my $pid = <PIDFILE>;
903 close(PIDFILE);
904 if ( ! -e "/proc/$pid" || !`grep $Config{"l3-agent"} /proc/$pid/cmdline && grep "uid:.*\b$<\b" /proc/$pid/status`) {
905 print "Removing stale pidfile\n";
906 unlink $Config{agent_pidfile};
907 or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!";
908 }
909 else {
910 print "l3-agent is already running\n";
911 exit(0);
912 }
913 }
914 if ($Config{detach} =~ /^y/i) {
915 #$Config{verbose} = "no";
916 my $pid = fork;
917 exit if $pid;
918 die "Couldn't fork: $!" unless defined ($pid);
920 open(PIDFILE, ">", $Config{agent_pidfile})
921 or die "Can't open pidfile ". $Config{agent_pidfile}. " for wrting: $!";
922 print PIDFILE $$;
923 close(PIDFILE);
925 for my $handle (*STDIN, *STDOUT, *STDERR) {
926 open ($handle, "+<", "/dev/null")
927 or die "can't reopen $handle to /dev/null: $!"
928 }
930 POSIX::setsid()
931 or die "Can't start a new session: $!";
933 $0 = $Config{"l3-agent"};
935 $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&process_was_killed;
936 }
937 while (not $Killed) {
938 @Command_Lines = ();
939 @Command_Lines_Index = ();
940 load_cache_stat();
941 load_command_lines($Config{"input"}, $Config{"input_mask"});
942 if (@Command_Lines) {
943 sort_command_lines;
944 process_command_lines;
945 print_command_lines($Config{"cache"});
946 }
947 sleep($Config{"daemon_sleep_interval"} || 1);
948 }
950 unlink $Config{agent_pidfile};
951 }
953 }
955 sub init_variables
956 {
957 }