lilalo
view l3-agent @ 71:d499fa3b2af1
Na lilalo@moskau.xt.vpn uspeshno zavelos i\
zarabotalo. + Sohranenie istorii pri vyhode
zarabotalo. + Sohranenie istorii pri vyhode
| author | devi | 
|---|---|
| date | Sat Feb 04 00:47:22 2006 +0200 (2006-02-04) | 
| parents | 70db89d4f840 | 
| children | 0ffdebbccfce | 
 line source
     1 #!/usr/bin/perl -w
     3 #
     4 # (c) Igor Chubin, igor@chub.in, 2004-2006
     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 %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_commands_from_cline;
    41 sub load_command_lines;
    42 sub sort_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_key;
   143                 $min_dt = $dt;  
   144         }
   145     }
   146 }
   149 sub extract_commands_from_cline
   150 # Разобрать командную строку $_[1] и возвратить хэш, содержащий 
   151 # номер первого появление команды в строке:
   152 #   команда => первая позиция
   153 {
   154     my $cline = $_[0];
   155     my @lists = split /\;/, $cline;
   158     my @commands = ();
   159     for my $list (@lists) {
   160         push @commands, split /\|/, $list;
   161     }
   163     my %commands;
   164     my %files;
   165     my $i=0;
   166     for my $command (@commands) {
   167         $command =~ /\s*(\S+)\s*(.*)/;
   168         if ($1 && $1 eq "sudo" ) {
   169             $commands{"$1"}=$i++;
   170             $command =~ s/\s*sudo\s+//;
   171         }
   172         $command =~ /\s*(\S+)\s*(.*)/;
   173         if ($1 && !defined $commands{"$1"}) {
   174                 $commands{"$1"}=$i++;
   175         };  
   176     }
   177     return %commands;
   178 }
   180 sub load_command_lines
   181 {
   182     my $lab_scripts_path = $_[0];
   183     my $lab_scripts_mask = $_[1];
   185     my $cline_re_base = qq'
   186             (
   187             (?:\\^?([0-9]*C?))          # exitcode
   188             (?:_([0-9]+)_)?             # uid
   189             (?:_([0-9]+)_)              # pid
   190             (...?)                  # day
   191             (.?.?)                  # lab
   192             \\s                 # space separator
   193             ([0-9][0-9]):([0-9][0-9]):([0-9][0-9])  # time
   194             .\\[50D.\\[K                # killing symbols
   195             (.*?([\$\#]\\s?))           # prompt
   196             (.*)                    # command line
   197             )
   198             ';
   199     #my $cline_re = qr/$cline_re_base(?:$cline_re_base|$)/x;
   200     #my $cline_re = qr/(?:$cline_re_base)*$cline_re_base$/x;
   201     my $cline_re = qr/$cline_re_base/sx;
   202     my $cline_re1 = qr/$cline_re_base\x0D/sx;
   203     my $cline_re2 = qr/$cline_re_base$/sx;
   205     my $vt = Term::VT102->new ( 'cols' => $Config{"terminal_width"}, 
   206                     'rows' => $Config{"terminal_height"});
   207     my $cline_vt = Term::VT102->new ('cols' => $Config{"terminal_width"}, 
   208                     'rows' => $Config{"terminal_height"});
   210     my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8")
   211         if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i);
   213     print "Loading lm-scripts...\n" if $Config{"verbose"} =~ /y/;
   215     my $file;
   216     my $skip_info;
   218     my $commandlines_loaded =0;
   219     my $commandlines_processed =0;
   221     my @lab_scripts = <$lab_scripts_path/$lab_scripts_mask>;
   222     for $file (@lab_scripts){
   224         # Пропускаем файл, если он не изменялся со времени нашего предудущего прохода
   225         my $size = (stat($file))[7];
   226         next if ($Script_Files{$file} && $Script_Files{$file}->{size} && $Script_Files{$file}->{size} >= $size);
   229         my $local_session_id;
   230         # Начальное значение идентификатора текущего сеанса определяем из имени скрипта
   231         # Впоследствии оно может быть уточнено
   232         $file =~ m@.*/([^/]*)\.script$@;
   233         $local_session_id = $1;
   235         #Если файл только что появился, 
   236         #пытаемся найти и загрузить информацию о соответствующей ему сессии
   237         if (!$Script_Files{$file}) {
   238             my $session_file = $file;
   239             $session_file =~ s/\.script/.info/;
   240             if (open(SESSION, $session_file)) {
   241                 local $/;
   242                 my $data = <SESSION>;
   243                 close(SESSION);
   245                 for my $session_data ($data =~ m@<session>(.*?)</session>@sg) {
   246                     my %session;
   247                     while ($session_data =~ m@<([^>]*?)>(.*?)</\1>@sg) {
   248                         $session{$1} = $2;
   249                     }
   250                     $local_session_id = $session{"local_session_id"} if $session{"local_session_id"};
   251                     $Sessions{$local_session_id}=\%session;
   252                 }
   254                 #Загруженную информацию сразу же отправляем в поток
   255                 print_session($Config{cache}, $local_session_id);
   256             }
   257         }
   259         open (FILE, "$file");
   260         binmode FILE;
   262         # Переходим к тому месту, где мы окончили разбор
   263         seek (FILE, $Script_Files{$file}->{tell}, 0) if $Script_Files{$file}->{tell};
   264         $Script_Files{$file}->{size} = $size;
   265         $Script_Files{$file}->{tell} = 0 unless $Script_Files{$file}->{tell};
   267         $file =~ m@.*/(.*?)-.*@;
   269         my $tty = $1;
   270         my $first_pass = 1;
   271         my %cl;
   272         my $last_output_length=0;
   273         while (<FILE>) {
   274             $commandlines_processed++;
   276             next if s/^Script started on.*?\n//s;
   278             if (/[0-9][0-9]:[0-9][0-9]:[0-9][0-9].\[[0-9][0-9]D.\[K/ && m/$cline_re/) {
   279                 s/.*\x0d(?!\x0a)//;
   280                 m/$cline_re2/gs;
   282                 $commandlines_loaded++;
   283                 $last_output_length=0;
   285                 # Previous command
   286                 my %last_cl = %cl;
   287                 my $err = $2 || "";
   289                 $cl{"local_session_id"} = $local_session_id;
   290                 # Parse new command 
   291                 $cl{"uid"} = $3;
   292                 $cl{"euid"} = $cl{"uid"};   # Если в команде обнаружится sudo, euid поменяем на 0
   293                 $cl{"pid"} = $4;
   294                 $cl{"day"} = $5;
   295                 $cl{"lab"} = $6;
   296                 $cl{"hour"} = $7;
   297                 $cl{"min"} = $8;
   298                 $cl{"sec"} = $9;
   299                 $cl{"fullprompt"} = $10;
   300                 $cl{"prompt"} = $11;
   301                 $cl{"raw_cline"} = $12; 
   303                 {
   304                 use bytes;
   305                 $cl{"raw_start"} = tell (FILE) - length($1);
   306                 $cl{"raw_output_start"} = tell FILE;
   307                 }
   308                 $cl{"raw_file"} = $file;
   310                 $cl{"err"} = 0;
   311                 $cl{"output"} = "";
   312                 $cl{"tty"} = $tty;
   314                 $cline_vt->process($cl{"raw_cline"}."\n");
   315                 $cl{"cline"} = $cline_vt->row_plaintext (1);
   316                 $cl{"cline"} =~ s/\s*$//;
   317                 $cline_vt->reset();
   319                 my %commands = extract_commands_from_cline($cl{"cline"});
   320                 $cl{"euid"}=0 if defined $commands{"sudo"};
   321                 my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands; 
   322                 $cl{"last_command"} = $comms[$#comms] || ""; 
   324                 if (
   325                     $Config{"suppress_editors"} =~ /^y/i 
   326                         && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}}) 
   327                     || $Config{"suppress_pagers"}  =~ /^y/i 
   328                         && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}}) 
   329                     || $Config{"suppress_terminal"}=~ /^y/i 
   330                         && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}})
   331                 ) {
   332                     $cl{"suppress_output"} = "1";
   333                 }
   334                 else {
   335                     $cl{"suppress_output"} = "0";
   336                 }
   337                 $skip_info = 0;
   340                 print " ",$cl{"last_command"};
   342                 # Processing previous command line
   343                 if ($first_pass) {
   344                     $first_pass = 0;
   345                     next;
   346                 }
   348                 # Error code
   349                 $last_cl{"raw_end"} = $cl{"raw_start"};
   350                 $last_cl{"err"}=$err;
   351                 $last_cl{"err"}=130 if $err eq "^C";
   353                 if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) {
   354                     bind_diff(\%last_cl);
   355                 }
   357                 # Output
   358                 if (!$last_cl{"suppress_output"} || $last_cl{"err"}) {
   359                     for (my $i=0; $i<$Config{"terminal_height"}; $i++) {
   360                         my $line= $vt->row_plaintext($i);
   361                         next if !defined ($line) ; #|| $line =~ /^\s*$/;
   362                         $line =~ s/\s*$//;
   363                         $line .= "\n" unless $line =~ /^\s*$/;
   364                         $last_cl{"output"} .= $line;
   365                     }
   366                 }
   367                 else {
   368                     $last_cl{"output"}= "";
   369                 }
   371                 $vt->reset();
   374                 # Classifying the command line
   377                 # Save 
   378                 if (!$Config{"lab"} || $cl{"lab"} eq $Config{"lab"}) {
   379                     # Changing encoding 
   380                     for (keys %last_cl) {
   381                         next if /raw/;
   382                         $last_cl{$_} = $converter->convert($last_cl{$_})
   383                             if ($Config{"encoding"} && 
   384                             $Config{"encoding"} !~ /^utf-8$/i);
   385                     }
   386                     push @Command_Lines, \%last_cl; 
   388                     # Сохранение позиции в файле, до которой выполнен
   389                     # успешный разбор
   390                     $Script_Files{$file}->{tell} = $last_cl{raw_end};
   391                 }   
   392                 next;
   393             }
   394             $last_output_length+=length($_);
   395             #if (!$cl{"suppress_output"} || $last_output_length < 5000) {
   396             if ($last_output_length < 50000) {
   397                 $vt->process("$_"."\n") 
   398             }
   399             else
   400             {
   401                 if (!$skip_info) {
   402                     print "($cl{last_command})";
   403                     $skip_info = 1;
   404                 }
   405             }
   406         }   
   407         close(FILE);
   409     }
   410     if ($Config{"verbose"} =~ /y/) {
   411         print "...finished." ;
   412         print "Lines loaded: $commandlines_processed\n";
   413         print "Command lines: $commandlines_loaded\n";
   414     }
   415 }
   420 sub sort_command_lines
   421 {
   422     print "Sorting command lines...\n" if $Config{"verbose"} =~ /y/;
   424     # Sort Command_Lines
   425     # Write Command_Lines to Command_Lines_Index
   427     my @index;
   428     for (my $i=0;$i<=$#Command_Lines;$i++) {
   429         $index[$i]=$i;
   430     }
   432     @Command_Lines_Index = sort {
   433         $Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"} ||
   434         $Command_Lines[$index[$a]]->{"hour"} <=> $Command_Lines[$index[$b]]->{"hour"} ||
   435         $Command_Lines[$index[$a]]->{"min"} <=> $Command_Lines[$index[$b]]->{"min"} ||
   436         $Command_Lines[$index[$a]]->{"sec"} <=> $Command_Lines[$index[$b]]->{"sec"}
   437     } @index;
   439     print "...finished\n" if $Config{"verbose"} =~ /y/;
   441 }
   443 sub printq
   444 {
   445     my $TO = shift;
   446     my $text = join "", @_;
   447     $text =~ s/&/&/g;
   448     $text =~ s/</</g;
   449     $text =~ s/>/>/g;
   450     print $TO $text;
   451 }
   454 =cut 
   455 Вывести результат обработки журнала.
   456 =cut
   458 sub print_command_lines
   459 {
   460     my $output_filename=$_[0];
   461     my $mode = ">";
   462     $mode =">>" if $Config{mode} eq "daemon";
   463     open(OUT, $mode, $output_filename)
   464         or die "Can't open $output_filename for writing\n";
   467     my $cl;
   468     my $in_range=0;
   469     for my $i (@Command_Lines_Index) {
   470         $cl = $Command_Lines[$i];
   472         if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {
   473             $in_range=1;
   474             next;
   475         }
   476         if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {
   477             $in_range=0;
   478             next;
   479         }
   480         next if ($Config{"from"} && $Config{"to"} && !$in_range) 
   481             ||
   482                 ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )
   483             ||
   484             ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)
   485             ||
   486             ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);
   488         # Вырезаем из вывода только нужное количество строк
   490         my $output="";
   492         if (!grep ($_ eq $cl{"last_command"}, @{$Config{"full_output_commands"}})
   493             && ($Config{"head_lines"} 
   494             || $Config{"tail_lines"})) 
   495             # Partialy output
   496             my @lines = split '\n', $cl->{"output"};
   497             # head
   498             my $mark=1;
   499             for (my $i=0; $i<= $#lines && $i < $Config{"cache_head_lines"}; $i++) {
   500                 $output .= $lines[$i]."\n";
   501             }
   502             # tail
   503             my $start=$#lines-$Config{"cache_tail_lines"}+1;
   504             if ($start < 0) {
   505                 $start=0;
   506                 $mark=0;
   507             }   
   508             if ($start < $Config{"cache_head_lines"}) {
   509                 $start=$Config{"cache_head_lines"};
   510                 $mark=0;
   511             }   
   512             $output .= $Config{"skip_text"}."\n" if $mark;
   513             for (my $i=$start; $i<= $#lines; $i++) {
   514                 $output .= $lines[$i]."\n";
   515             }
   516         } 
   517         else {
   518             # Full output
   519             $output .= $cl->{"output"};
   520         }   
   522         # Совместимость с labmaker
   524         # Переводим в секунды Эпохи
   525         # В labmaker'е данные хранились в неудобной форме: hour, min, sec, day of year
   526         # Информация о годе отсутствовала
   527         # Её можно внести: 
   528         # Декабрь 2004 год; остальные -- 2005 год.
   530         my $year = 2005;
   531         #$year = 2004 if ( $cl->{day} > 330 );
   532         $year = $Config{year} if $Config{year};
   533         # timelocal(            $sec,      $min,      $hour,      $mday,$mon,$year);
   534         $cl->{time} = timelocal_nocheck($cl->{sec},$cl->{min},$cl->{hour},$cl->{day},0,$year);
   537         # Начинаем вывод команды
   538         print OUT "<command>\n";
   539         for my $element (qw(
   540             local_session_id
   541             time
   542             raw_start
   543             raw_output_start
   544             raw_end
   545             raw_file
   546             tty
   547             uid
   548             err
   549             last_command
   550             )) {
   551             next unless defined($cl->{"$element"});
   552             print OUT "<$element>".$cl->{$element}."</$element>\n";
   553         }
   554         for my $element (qw(
   555             prompt
   556             cline
   557             note
   558             note_title
   559             )) {
   560             next unless defined($cl->{"$element"});
   561             print OUT "<$element>";
   562             printq(\*OUT,$cl->{"$element"});
   563             print OUT "</$element>\n";
   564         }
   565         print OUT "<output>";
   566         printq(\*OUT,$output);
   567         print OUT "</output>\n";
   568         if ($cl->{"diff"}) {
   569             print OUT "<diff>";
   570             printq(\*OUT,${$Diffs{$cl->{"diff"}}}{"text"});
   571             print OUT "</diff>\n";
   572         }
   573         print OUT "</command>\n";
   575     }
   577     close(OUT);
   578 }
   580 sub print_session
   581 {
   582     my $output_filename = $_[0];
   583     my $local_session_id = $_[1];
   584     return if not defined($Sessions{$local_session_id});
   586     open(OUT, ">>", $output_filename)
   587         or die "Can't open $output_filename for writing\n";
   588     print OUT "<session>\n";
   589     my %session = %{$Sessions{$local_session_id}};
   590     for my $key (keys %session) {
   591         print OUT "<$key>".$session{$key}."</$key>\n"
   592     }
   593     print OUT "</session>\n";
   594     close(OUT);
   595 }
   597 sub send_cache
   598 {
   599     # Если в кэше что-то накопилось, 
   600     # попытаемся отправить это на сервер
   601     #
   602     my $cache_was_sent=0;
   604     if (open(CACHE, $Config{cache})) {
   605         local $/;
   606         my $cache = <CACHE>;
   607         close(CACHE);
   609         my $socket = IO::Socket::INET->new(
   610                             PeerAddr => $Config{backend_address},
   611                             PeerPort => $Config{backend_port},
   612                             proto   => "tcp",
   613                             Type    => SOCK_STREAM
   614                         );
   616         if ($socket) {
   617             print $socket $cache;
   618             close($socket);
   619             $cache_was_sent = 1;
   620         }
   621     }
   622     return $cache_was_sent;
   623 }
   625 sub save_cache_stat
   626 {
   627     open (CACHE, ">$Config{cache_stat}");
   628     for my $f (keys %Script_Files) {
   629         print CACHE "$f\t",$Script_Files{$f}->{size},"\t",$Script_Files{$f}->{tell},"\n";
   630     }
   631     close(CACHE);
   632 }
   634 sub load_cache_stat
   635 {
   636     if (open (CACHE, "$Config{cache_stat}")) {
   637         while(<CACHE>) {
   638             chomp;
   639             my ($f, $size, $tell) = split /\t/;
   640             $Script_Files{$f}->{size} = $size;
   641             $Script_Files{$f}->{tell} = $tell;
   642         }
   643         close(CACHE);
   644     };
   645 }
   648 main();
   650 sub process_was_killed
   651 {
   652     $Killed = 1;
   653 }
   655 sub main
   656 {
   658     $| = 1;
   660     init_variables();
   661     init_config();
   664     if ($Config{"mode"} ne "daemon") {
   666 =cut
   667     В нормальном режиме работы нужно
   668     считать скрипты, обработать их и записать
   669     результат выполнения в результирующий файл.
   670     После этого завершить работу.
   671 =cut
   672         for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) {
   673             load_diff_files($lab_log);
   674         }
   675         load_command_lines($Config{"input"}, $Config{"input_mask"});
   676         sort_command_lines;
   677         #process_command_lines;
   678         print_command_lines($Config{"cache"});
   679     } 
   680     else {
   681         if (open(PIDFILE, $Config{agent_pidfile})) {
   682             my $pid = <PIDFILE>;
   683             close(PIDFILE);
   684             if ($^O eq 'linux' && $pid &&(! -e "/proc/$pid" || !`grep $Config{"l3-agent"} /proc/$pid/cmdline && grep "uid:.*\b$<\b" /proc/$pid/status`)) {
   685                 print "Removing stale pidfile\n";
   686                 unlink $Config{agent_pidfile}
   687                     or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!";
   688             }
   689             elsif ($^O eq 'freebsd' && $pid && `ps axo uid,pid,command | grep '$<\\s*$pid\\s*$Config{"l3-agent"}' 2> /dev/null`) {
   690                 print "Removing stale pidfile\n";
   691                 unlink $Config{agent_pidfile}
   692                     or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!";
   693             }
   694             elsif ($^O eq 'linux' || $^O eq 'freebsd' ) {
   695                 print "l3-agent is already running: pid=$pid; pidfile=$Config{agent_pidfile}\n";
   696                 exit(0);
   697             }
   698             else {
   699                 print "Unknown operating system";
   700                 exit(0);
   701             }
   702         }
   703         if ($Config{detach} =~ /^y/i) {
   704             #$Config{verbose} = "no";
   705             my $pid = fork;
   706             exit if $pid;
   707             die "Couldn't fork: $!" unless defined ($pid);
   709             open(PIDFILE, ">", $Config{agent_pidfile})
   710                 or die "Can't open pidfile ". $Config{agent_pidfile}. " for wrting: $!";
   711             print PIDFILE $$;
   712             close(PIDFILE);
   714             for my $handle (*STDIN, *STDOUT, *STDERR) {
   715                 open ($handle, "+<", "/dev/null")
   716                     or die "can't reopen $handle to /dev/null: $!"
   717             }
   719             POSIX::setsid()
   720                 or die "Can't start a new session: $!";
   722             $0 = $Config{"l3-agent"};
   724             $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&process_was_killed;
   725         }
   726         while (not $Killed) {
   727             @Command_Lines = ();
   728             @Command_Lines_Index = ();
   729             for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) {
   730                 load_diff_files($lab_log);
   731             }
   732             load_cache_stat();
   733             load_command_lines($Config{"input"}, $Config{"input_mask"});
   734             if (@Command_Lines) {
   735                 #sort_command_lines;
   736                 #process_command_lines;
   737                 print_command_lines($Config{"cache"});
   738             }
   739             save_cache_stat();
   740             if (-e $Config{cache} && (stat($Config{cache}))[7]) {
   741                 send_cache() && unlink($Config{cache});
   742             }
   743             sleep($Config{"daemon_sleep_interval"} || 1);
   744         }
   746         unlink $Config{agent_pidfile};
   747     }
   749 }
   751 sub init_variables
   752 {
   753 }
