| rev | line source | 
| devi@52 | 1 #!/usr/bin/perl -w | 
| devi@23 | 2 | 
| devi@23 | 3 # | 
| devi@62 | 4 # (c) Igor Chubin, igor@chub.in, 2004-2006 | 
| devi@23 | 5 # | 
| devi@23 | 6 | 
| devi@50 | 7 | 
| devi@50 | 8 ## Эта строчка добавлена из блокнота Windows | 
| devi@50 | 9 ## Надо отдать должное, он каким-то образом научился понимать кодировку | 
| devi@50 | 10 | 
| devi@23 | 11 use strict; | 
| devi@25 | 12 use POSIX; | 
| devi@23 | 13 use Term::VT102; | 
| devi@23 | 14 use Text::Iconv; | 
| devi@23 | 15 use Time::Local 'timelocal_nocheck'; | 
| devi@27 | 16 use IO::Socket; | 
| devi@23 | 17 | 
| igor@115 | 18 use lib "/etc/lilalo"; | 
| devi@23 | 19 use l3config; | 
| devi@23 | 20 | 
| devi@23 | 21 | 
| devi@23 | 22 our @Command_Lines; | 
| devi@23 | 23 our @Command_Lines_Index; | 
| devi@28 | 24 our %Diffs; | 
| devi@27 | 25 our %Sessions; | 
| devi@23 | 26 | 
| devi@62 | 27 our %Script_Files;  # Информация о позициях в скрипт-файлах, | 
| devi@62 | 28                     # до которых уже выполнен разбор | 
| devi@62 | 29                     # и информация о времени модификации файла | 
| devi@62 | 30                     #   $Script_Files{$file}->{size} | 
| devi@62 | 31                     #   $Script_Files{$file}->{tell} | 
| devi@23 | 32 | 
| devi@62 | 33 our $Killed =0;     # В режиме демона -- процесс получил сигнал о завершении | 
| devi@23 | 34 | 
| devi@23 | 35 sub init_variables; | 
| devi@23 | 36 sub main; | 
| devi@23 | 37 | 
| devi@23 | 38 sub load_diff_files; | 
| devi@23 | 39 sub bind_diff; | 
| devi@62 | 40 sub extract_commands_from_cline; | 
| devi@23 | 41 sub load_command_lines; | 
| devi@23 | 42 sub sort_command_lines; | 
| devi@23 | 43 sub print_command_lines; | 
| devi@23 | 44 sub printq; | 
| devi@23 | 45 | 
| devi@25 | 46 sub save_cache_stat; | 
| devi@25 | 47 sub load_cache_stat; | 
| devi@27 | 48 sub print_session; | 
| devi@25 | 49 | 
| devi@23 | 50 sub load_diff_files | 
| devi@23 | 51 { | 
| devi@62 | 52     my @pathes = @_; | 
| devi@62 | 53 | 
| devi@62 | 54     for my $path (@pathes) { | 
| devi@62 | 55         my $template = "*.diff"; | 
| devi@62 | 56         my @files = <$path/$template>; | 
| devi@62 | 57         my $i=0; | 
| devi@62 | 58         for my $file (@files) { | 
| devi@28 | 59 | 
| devi@62 | 60             next if defined($Diffs{$file}); | 
| devi@62 | 61             my %diff; | 
| devi@23 | 62 | 
| devi@80 | 63 # Старый формат имени diff-файла | 
| devi@80 | 64 # DEPRECATED | 
| devi@80 | 65             if ($file=~m@/(D?[0-9][0-9]?[0-9]?)[^/]*?([0-9]*):([0-9]*):?([0-9]*)@) { | 
| devi@80 | 66                 $diff{"day"}=$1 || ""; | 
| devi@80 | 67                 $diff{"hour"}=$2; | 
| devi@80 | 68                 $diff{"min"}=$3; | 
| devi@80 | 69                 $diff{"sec"}=$4 || 0; | 
| devi@80 | 70 | 
| devi@80 | 71                 $diff{"uid"} = 0 if $path =~ m@/root/@; | 
| devi@23 | 72 | 
| devi@62 | 73             print "diff loaded: $diff{day} $diff{hour}:$diff{min}:$diff{sec}\n"; | 
| devi@80 | 74 | 
| devi@80 | 75             } | 
| devi@80 | 76 # Новый формат имени diff-файла | 
| devi@80 | 77             elsif ($file =~ m@.*/([^_]*)_([0-9]+)(.*)@) { | 
| devi@80 | 78                 $diff{"local_session_id"} = $1; | 
| devi@80 | 79                 $diff{"time"} = $2; | 
| devi@80 | 80                 $diff{"filename"} = $3; | 
| devi@80 | 81                 $diff{"filename"} =~ s@_@/@g; | 
| devi@80 | 82                 $diff{"filename"} =~ s@//@_@g; | 
| devi@80 | 83 | 
| devi@80 | 84                 print "diff loaded: $diff{filename} (time=$diff{time},session=$diff{local_session_id})\n"; | 
| devi@80 | 85             } | 
| devi@80 | 86             else { | 
| devi@80 | 87                 next; | 
| devi@80 | 88             } | 
| devi@80 | 89 | 
| devi@80 | 90 # Чтение и изменение кодировки содержимого diff-файла | 
| devi@62 | 91             local $/; | 
| devi@62 | 92             open (F, "$file") | 
| devi@62 | 93                 or return "Can't open file $file ($_[0]) for reading"; | 
| devi@62 | 94             my $text = <F>; | 
| devi@62 | 95             if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i) { | 
| devi@62 | 96                 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8"); | 
| devi@62 | 97                 $text = $converter->convert($text); | 
| devi@62 | 98             } | 
| devi@62 | 99             close(F); | 
| devi@62 | 100             $diff{"text"}=$text; | 
| devi@23 | 101 | 
| devi@80 | 102             $diff{"path"}=$path; | 
| devi@80 | 103             $diff{"bind_to"}=""; | 
| devi@80 | 104             $diff{"time_range"}=-1; | 
| devi@80 | 105             $diff{"index"}=$i; | 
| devi@80 | 106 | 
| devi@62 | 107             $Diffs{$file} = \%diff; | 
| devi@62 | 108             $i++; | 
| devi@62 | 109         } | 
| devi@62 | 110     } | 
| devi@23 | 111 } | 
| devi@23 | 112 | 
| devi@23 | 113 | 
| devi@23 | 114 sub bind_diff | 
| devi@23 | 115 { | 
| devi@62 | 116     print "Trying to bind diff...\n"; | 
| devi@23 | 117 | 
| devi@62 | 118     my $cl = shift; | 
| devi@62 | 119     my $hour = $cl->{"hour"}; | 
| devi@62 | 120     my $min = $cl->{"min"}; | 
| devi@62 | 121     my $sec = $cl->{"sec"}; | 
| devi@23 | 122 | 
| devi@62 | 123     my $min_dt = 10000; | 
| devi@23 | 124 | 
| devi@62 | 125     for my $diff_key (keys %Diffs) { | 
| devi@62 | 126             my $diff = $Diffs{$diff_key}; | 
| devi@80 | 127             next if ($diff->{"local_session_id"} | 
| devi@80 | 128                     && $cl->{"local_session_id"} | 
| devi@80 | 129                     && ($cl->{"local_session_id"} ne $diff->{"local_session_id"})); | 
| devi@80 | 130 | 
| devi@62 | 131             next if ($diff->{"day"} && $cl->{"day"} && ($cl->{"day"} ne $diff->{"day"})); | 
| devi@80 | 132 | 
| devi@80 | 133             my $dt; | 
| devi@80 | 134             if ($diff->{"time"} && $cl->{"time"}) { | 
| devi@80 | 135                 $dt = $diff->{"time"} - $cl->{"time"} | 
| devi@80 | 136             } | 
| devi@80 | 137             else { | 
| devi@80 | 138                 $dt=($diff->{"hour"}-$hour)*3600 +($diff->{"min"}-$min)*60 + ($diff->{"sec"}-$sec); | 
| devi@80 | 139             } | 
| devi@80 | 140             if ($dt >0 | 
| devi@80 | 141                     && $dt < $min_dt | 
| devi@80 | 142                     && ($diff->{"time_range"} <0 | 
| devi@80 | 143                     || $dt < $diff->{"time_range"})) { | 
| devi@62 | 144                 print "Approppriate diff found: dt=$dt\n"; | 
| devi@62 | 145                 if ($diff->{"bind_to"}) { | 
| devi@62 | 146                     undef $diff->{"bind_to"}->{"diff"}; | 
| devi@62 | 147                 }; | 
| devi@62 | 148                 $diff->{"time_range"}=$dt; | 
| devi@62 | 149                 $diff->{"bind_to"}=$cl; | 
| devi@23 | 150 | 
| devi@62 | 151                 $cl->{"diff"} = $diff_key; | 
| devi@62 | 152                 $min_dt = $dt; | 
| devi@80 | 153             } | 
| devi@62 | 154     } | 
| devi@23 | 155 } | 
| devi@23 | 156 | 
| devi@23 | 157 | 
| devi@62 | 158 sub extract_commands_from_cline | 
| devi@23 | 159 # Разобрать командную строку $_[1] и возвратить хэш, содержащий | 
| devi@23 | 160 # номер первого появление команды в строке: | 
| devi@62 | 161 #   команда => первая позиция | 
| devi@23 | 162 { | 
| devi@62 | 163     my $cline = $_[0]; | 
| devi@62 | 164     my @lists = split /\;/, $cline; | 
| devi@62 | 165 | 
| devi@62 | 166 | 
| devi@62 | 167     my @commands = (); | 
| devi@62 | 168     for my $list (@lists) { | 
| devi@62 | 169         push @commands, split /\|/, $list; | 
| devi@62 | 170     } | 
| devi@23 | 171 | 
| devi@62 | 172     my %commands; | 
| devi@62 | 173     my %files; | 
| devi@62 | 174     my $i=0; | 
| devi@62 | 175     for my $command (@commands) { | 
| devi@62 | 176         $command =~ /\s*(\S+)\s*(.*)/; | 
| devi@62 | 177         if ($1 && $1 eq "sudo" ) { | 
| devi@62 | 178             $commands{"$1"}=$i++; | 
| devi@62 | 179             $command =~ s/\s*sudo\s+//; | 
| devi@62 | 180         } | 
| devi@62 | 181         $command =~ /\s*(\S+)\s*(.*)/; | 
| devi@62 | 182         if ($1 && !defined $commands{"$1"}) { | 
| devi@62 | 183                 $commands{"$1"}=$i++; | 
| devi@62 | 184         }; | 
| devi@62 | 185     } | 
| devi@62 | 186     return %commands; | 
| devi@23 | 187 } | 
| devi@23 | 188 | 
| devi@23 | 189 sub load_command_lines | 
| devi@23 | 190 { | 
| devi@62 | 191     my $lab_scripts_path = $_[0]; | 
| devi@62 | 192     my $lab_scripts_mask = $_[1]; | 
| devi@23 | 193 | 
| devi@62 | 194     my $cline_re_base = qq' | 
| devi@62 | 195             ( | 
| devi@62 | 196             (?:\\^?([0-9]*C?))          # exitcode | 
| devi@62 | 197             (?:_([0-9]+)_)?             # uid | 
| devi@62 | 198             (?:_([0-9]+)_)              # pid | 
| devi@62 | 199             (...?)                  # day | 
| devi@62 | 200             (.?.?)                  # lab | 
| devi@62 | 201             \\s                 # space separator | 
| devi@62 | 202             ([0-9][0-9]):([0-9][0-9]):([0-9][0-9])  # time | 
| devi@62 | 203             .\\[50D.\\[K                # killing symbols | 
| devi@62 | 204             (.*?([\$\#]\\s?))           # prompt | 
| devi@62 | 205             (.*)                    # command line | 
| devi@62 | 206             ) | 
| devi@62 | 207             '; | 
| devi@62 | 208     my $cline_re = qr/$cline_re_base/sx; | 
| devi@62 | 209     my $cline_re2 = qr/$cline_re_base$/sx; | 
| devi@23 | 210 | 
| devi@74 | 211     my $cline_re_v2_base = qq' | 
| devi@74 | 212             ( | 
| devi@74 | 213             v2[\#]                      # version | 
| devi@74 | 214             ([0-9]+)[\#]                # history line number | 
| devi@74 | 215             ([0-9]+)[\#]                # exitcode | 
| devi@74 | 216             ([0-9]+)[\#]                # uid | 
| devi@74 | 217             ([0-9]+)[\#]                # pid | 
| devi@74 | 218             ([0-9]+)[\#]                # time | 
| igor@114 | 219             (.*?)[\#]                   # pwd | 
| devi@74 | 220             .\\[1024D.\\[K              # killing symbols | 
| devi@74 | 221             (.*?([\$\#]\\s?))           # prompt | 
| devi@74 | 222             (.*)                        # command line | 
| devi@74 | 223             ) | 
| devi@74 | 224             '; | 
| devi@74 | 225 | 
| devi@74 | 226     my $cline_re_v2 = qr/$cline_re_v2_base/sx; | 
| devi@74 | 227     my $cline_re2_v2 = qr/$cline_re_v2_base$/sx; | 
| devi@74 | 228 | 
| igor@114 | 229     my $cline_re_v3_base = qq' | 
| igor@114 | 230             ( | 
| igor@114 | 231             v3[\#]                      # version | 
| igor@114 | 232             .* | 
| igor@114 | 233             ) | 
| igor@114 | 234             '; | 
| igor@114 | 235     my $cline_re_v3 = qr/$cline_re_v3_base/sx; | 
| igor@114 | 236 | 
| igor@114 | 237     my $cline_re2_v3_base = qq' | 
| igor@114 | 238             ( | 
| igor@114 | 239             v3[\#]                      # version | 
| igor@114 | 240             ([0-9]+)[\#]                # history line number | 
| igor@114 | 241             ([0-9]+)[\#]                # exitcode | 
| igor@114 | 242             ([0-9]+)[\#]                # uid | 
| igor@114 | 243             ([0-9]+)[\#]                # pid | 
| igor@114 | 244             ([0-9]+)[\#]                # time | 
| igor@114 | 245             (.*?)[\#]                   # pwd | 
| igor@114 | 246             (.*?([\$\#]\\s?))           # prompt | 
| igor@114 | 247             (.*)                        # command line | 
| igor@114 | 248             ) | 
| igor@114 | 249             '; | 
| igor@114 | 250     my $cline_re2_v3 = qr/$cline_re2_v3_base$/sx; | 
| igor@114 | 251 | 
| igor@114 | 252 | 
| igor@115 | 253     my %vt;     # Хэш виртуальных терминалов. По одному на каждый сеанс | 
| devi@81 | 254     my $cline_vt = Term::VT102->new ( | 
| devi@81 | 255                                 'cols' => $Config{"terminal_width"}, | 
| devi@81 | 256                                 'rows' => $Config{"terminal_height"}); | 
| devi@23 | 257 | 
| devi@62 | 258     my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8") | 
| devi@62 | 259         if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i); | 
| devi@62 | 260 | 
| devi@74 | 261     print "Parsing lab scripts...\n" if $Config{"verbose"} =~ /y/; | 
| devi@23 | 262 | 
| devi@62 | 263     my $file; | 
| devi@62 | 264     my $skip_info; | 
| devi@23 | 265 | 
| devi@62 | 266     my $commandlines_loaded =0; | 
| devi@62 | 267     my $commandlines_processed =0; | 
| devi@23 | 268 | 
| devi@62 | 269     my @lab_scripts = <$lab_scripts_path/$lab_scripts_mask>; | 
| devi@62 | 270     for $file (@lab_scripts){ | 
| devi@23 | 271 | 
| devi@62 | 272         # Пропускаем файл, если он не изменялся со времени нашего предудущего прохода | 
| devi@62 | 273         my $size = (stat($file))[7]; | 
| devi@62 | 274         next if ($Script_Files{$file} && $Script_Files{$file}->{size} && $Script_Files{$file}->{size} >= $size); | 
| devi@27 | 275 | 
| devi@27 | 276 | 
| devi@62 | 277         my $local_session_id; | 
| devi@62 | 278         # Начальное значение идентификатора текущего сеанса определяем из имени скрипта | 
| devi@62 | 279         # Впоследствии оно может быть уточнено | 
| devi@62 | 280         $file =~ m@.*/([^/]*)\.script$@; | 
| devi@62 | 281         $local_session_id = $1; | 
| devi@27 | 282 | 
| igor@115 | 283         if (not defined($vt{$local_session_id})) { | 
| igor@115 | 284             $vt{$local_session_id} = Term::VT102->new ( | 
| igor@115 | 285                                         'cols' => $Config{"terminal_width"}, | 
| igor@115 | 286                                         'rows' => $Config{"terminal_height"}); | 
| igor@115 | 287         } | 
| igor@115 | 288 | 
| devi@62 | 289         #Если файл только что появился, | 
| devi@62 | 290         #пытаемся найти и загрузить информацию о соответствующей ему сессии | 
| devi@62 | 291         if (!$Script_Files{$file}) { | 
| devi@62 | 292             my $session_file = $file; | 
| devi@62 | 293             $session_file =~ s/\.script/.info/; | 
| devi@62 | 294             if (open(SESSION, $session_file)) { | 
| devi@62 | 295                 local $/; | 
| devi@62 | 296                 my $data = <SESSION>; | 
| devi@62 | 297                 close(SESSION); | 
| devi@27 | 298 | 
| devi@62 | 299                 for my $session_data ($data =~ m@<session>(.*?)</session>@sg) { | 
| devi@62 | 300                     my %session; | 
| devi@62 | 301                     while ($session_data =~ m@<([^>]*?)>(.*?)</\1>@sg) { | 
| devi@62 | 302                         $session{$1} = $2; | 
| devi@62 | 303                     } | 
| devi@62 | 304                     $local_session_id = $session{"local_session_id"} if $session{"local_session_id"}; | 
| devi@62 | 305                     $Sessions{$local_session_id}=\%session; | 
| devi@62 | 306                 } | 
| devi@25 | 307 | 
| devi@62 | 308                 #Загруженную информацию сразу же отправляем в поток | 
| devi@62 | 309                 print_session($Config{cache}, $local_session_id); | 
| devi@62 | 310             } | 
| devi@84 | 311             else { | 
| devi@84 | 312                 die "can't open session file"; | 
| devi@84 | 313             } | 
| devi@62 | 314         } | 
| devi@25 | 315 | 
| devi@62 | 316         open (FILE, "$file"); | 
| devi@62 | 317         binmode FILE; | 
| devi@23 | 318 | 
| devi@62 | 319         # Переходим к тому месту, где мы окончили разбор | 
| devi@62 | 320         seek (FILE, $Script_Files{$file}->{tell}, 0) if $Script_Files{$file}->{tell}; | 
| devi@62 | 321         $Script_Files{$file}->{size} = $size; | 
| devi@62 | 322         $Script_Files{$file}->{tell} = 0 unless $Script_Files{$file}->{tell}; | 
| devi@32 | 323 | 
| devi@62 | 324         $file =~ m@.*/(.*?)-.*@; | 
| devi@23 | 325 | 
| devi@83 | 326         print "\n+- processing file $file\n|   " | 
| devi@83 | 327             if $Config{"verbose"} =~/y/; | 
| devi@74 | 328 | 
| devi@62 | 329         my $tty = $1; | 
| devi@62 | 330         my $first_pass = 1; | 
| devi@62 | 331         my %cl; | 
| devi@62 | 332         my $last_output_length=0; | 
| devi@62 | 333         while (<FILE>) { | 
| devi@62 | 334             $commandlines_processed++; | 
| devi@23 | 335 | 
| devi@62 | 336             next if s/^Script started on.*?\n//s; | 
| devi@23 | 337 | 
| devi@62 | 338             if (/[0-9][0-9]:[0-9][0-9]:[0-9][0-9].\[[0-9][0-9]D.\[K/ && m/$cline_re/) { | 
| devi@62 | 339                 s/.*\x0d(?!\x0a)//; | 
| devi@62 | 340                 m/$cline_re2/gs; | 
| devi@23 | 341 | 
| devi@62 | 342                 $commandlines_loaded++; | 
| devi@62 | 343                 $last_output_length=0; | 
| devi@23 | 344 | 
| devi@62 | 345                 # Previous command | 
| devi@62 | 346                 my %last_cl = %cl; | 
| devi@62 | 347                 my $err = $2 || ""; | 
| devi@23 | 348 | 
| devi@62 | 349                 $cl{"local_session_id"} = $local_session_id; | 
| devi@62 | 350                 # Parse new command | 
| devi@62 | 351                 $cl{"uid"} = $3; | 
| devi@74 | 352                 #$cl{"euid"} = $cl{"uid"};   # Если в команде обнаружится sudo, euid поменяем на 0 | 
| devi@62 | 353                 $cl{"pid"} = $4; | 
| devi@62 | 354                 $cl{"day"} = $5; | 
| devi@62 | 355                 $cl{"lab"} = $6; | 
| devi@62 | 356                 $cl{"hour"} = $7; | 
| devi@62 | 357                 $cl{"min"} = $8; | 
| devi@62 | 358                 $cl{"sec"} = $9; | 
| devi@72 | 359                 #$cl{"fullprompt"} = $10; | 
| devi@62 | 360                 $cl{"prompt"} = $11; | 
| devi@62 | 361                 $cl{"raw_cline"} = $12; | 
| devi@23 | 362 | 
| devi@62 | 363                 { | 
| devi@62 | 364                 use bytes; | 
| devi@62 | 365                 $cl{"raw_start"} = tell (FILE) - length($1); | 
| devi@62 | 366                 $cl{"raw_output_start"} = tell FILE; | 
| devi@62 | 367                 } | 
| devi@62 | 368                 $cl{"raw_file"} = $file; | 
| devi@23 | 369 | 
| devi@62 | 370                 $cl{"err"} = 0; | 
| devi@62 | 371                 $cl{"output"} = ""; | 
| devi@62 | 372                 $cl{"tty"} = $tty; | 
| devi@23 | 373 | 
| devi@62 | 374                 $cline_vt->process($cl{"raw_cline"}."\n"); | 
| devi@62 | 375                 $cl{"cline"} = $cline_vt->row_plaintext (1); | 
| devi@62 | 376                 $cl{"cline"} =~ s/\s*$//; | 
| devi@62 | 377                 $cline_vt->reset(); | 
| devi@23 | 378 | 
| devi@62 | 379                 my %commands = extract_commands_from_cline($cl{"cline"}); | 
| devi@74 | 380                 #$cl{"euid"}=0 if defined $commands{"sudo"}; | 
| devi@62 | 381                 my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands; | 
| devi@62 | 382                 $cl{"last_command"} = $comms[$#comms] || ""; | 
| devi@23 | 383 | 
| devi@62 | 384                 if ( | 
| devi@62 | 385                     $Config{"suppress_editors"} =~ /^y/i | 
| devi@62 | 386                         && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}}) | 
| devi@62 | 387                     || $Config{"suppress_pagers"}  =~ /^y/i | 
| devi@62 | 388                         && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}}) | 
| devi@62 | 389                     || $Config{"suppress_terminal"}=~ /^y/i | 
| devi@62 | 390                         && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}}) | 
| devi@62 | 391                 ) { | 
| devi@62 | 392                     $cl{"suppress_output"} = "1"; | 
| devi@62 | 393                 } | 
| devi@62 | 394                 else { | 
| devi@62 | 395                     $cl{"suppress_output"} = "0"; | 
| devi@62 | 396                 } | 
| devi@62 | 397                 $skip_info = 0; | 
| devi@23 | 398 | 
| devi@23 | 399 | 
| devi@62 | 400                 print " ",$cl{"last_command"}; | 
| devi@23 | 401 | 
| devi@62 | 402                 # Processing previous command line | 
| devi@62 | 403                 if ($first_pass) { | 
| devi@62 | 404                     $first_pass = 0; | 
| devi@62 | 405                     next; | 
| devi@62 | 406                 } | 
| devi@23 | 407 | 
| devi@62 | 408                 # Error code | 
| devi@62 | 409                 $last_cl{"raw_end"} = $cl{"raw_start"}; | 
| devi@62 | 410                 $last_cl{"err"}=$err; | 
| devi@62 | 411                 $last_cl{"err"}=130 if $err eq "^C"; | 
| devi@23 | 412 | 
| devi@62 | 413                 if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) { | 
| devi@62 | 414                     bind_diff(\%last_cl); | 
| devi@62 | 415                 } | 
| devi@23 | 416 | 
| devi@62 | 417                 # Output | 
| devi@62 | 418                 if (!$last_cl{"suppress_output"} || $last_cl{"err"}) { | 
| devi@62 | 419                     for (my $i=0; $i<$Config{"terminal_height"}; $i++) { | 
| igor@115 | 420                         my $line= $vt{$local_session_id}->row_plaintext($i); | 
| devi@62 | 421                         next if !defined ($line) ; #|| $line =~ /^\s*$/; | 
| devi@62 | 422                         $line =~ s/\s*$//; | 
| devi@62 | 423                         $line .= "\n" unless $line =~ /^\s*$/; | 
| devi@62 | 424                         $last_cl{"output"} .= $line; | 
| devi@62 | 425                     } | 
| devi@62 | 426                 } | 
| devi@62 | 427                 else { | 
| devi@62 | 428                     $last_cl{"output"}= ""; | 
| devi@62 | 429                 } | 
| devi@23 | 430 | 
| igor@115 | 431                 $vt{$local_session_id}->reset(); | 
| devi@23 | 432 | 
| devi@23 | 433 | 
| devi@62 | 434                 # Save | 
| devi@62 | 435                 if (!$Config{"lab"} || $cl{"lab"} eq $Config{"lab"}) { | 
| devi@62 | 436                     # Changing encoding | 
| devi@62 | 437                     for (keys %last_cl) { | 
| devi@62 | 438                         next if /raw/; | 
| devi@62 | 439                         $last_cl{$_} = $converter->convert($last_cl{$_}) | 
| devi@62 | 440                             if ($Config{"encoding"} && | 
| devi@62 | 441                             $Config{"encoding"} !~ /^utf-8$/i); | 
| devi@62 | 442                     } | 
| devi@62 | 443                     push @Command_Lines, \%last_cl; | 
| devi@23 | 444 | 
| devi@62 | 445                     # Сохранение позиции в файле, до которой выполнен | 
| devi@62 | 446                     # успешный разбор | 
| devi@62 | 447                     $Script_Files{$file}->{tell} = $last_cl{raw_end}; | 
| devi@62 | 448                 } | 
| devi@62 | 449                 next; | 
| devi@62 | 450             } | 
| devi@74 | 451 | 
| igor@114 | 452             elsif (m/$cline_re_v2/ || m/$cline_re_v3/) { | 
| devi@74 | 453 # Разбираем командную строку версии 2 | 
| devi@74 | 454 | 
| devi@74 | 455                 s/.*\x0d(?!\x0a)//; | 
| igor@114 | 456                 my $re; | 
| igor@114 | 457                 if (m/$cline_re_v2/) { | 
| igor@114 | 458                     $re=$cline_re2_v2; | 
| igor@114 | 459                 } | 
| igor@114 | 460                 else { | 
| igor@114 | 461                     s/.\[1K.\[10D//gs; | 
| igor@114 | 462                     $re=$cline_re2_v3; | 
| igor@114 | 463                 } | 
| igor@114 | 464                 m/$re/gs; | 
| devi@74 | 465 | 
| devi@74 | 466                 $commandlines_loaded++; | 
| devi@74 | 467                 $last_output_length=0; | 
| devi@74 | 468 | 
| devi@74 | 469                 # Previous command | 
| devi@74 | 470                 my %last_cl = %cl; | 
| devi@74 | 471 | 
| devi@74 | 472                 $cl{"local_session_id"} = $local_session_id; | 
| devi@74 | 473                 # Parse new command | 
| devi@74 | 474                 $cl{"history"}  = $2; | 
| devi@74 | 475                 my $err         = $3; | 
| devi@74 | 476                 $cl{"uid"}      = $4; | 
| devi@74 | 477                 #$cl{"euid"}     = $cl{"uid"};   # Если в команде обнаружится sudo, euid поменяем на 0 | 
| devi@74 | 478                 $cl{"pid"}      = $5; | 
| devi@74 | 479                 $cl{"time"}     = $6; | 
| devi@74 | 480                 $cl{"pwd"}      = $7; | 
| devi@74 | 481                 #$cl{"fullprompt"} = $8; | 
| devi@74 | 482                 $cl{"prompt"}   = $9; | 
| devi@74 | 483                 $cl{"raw_cline"}= $10; | 
| devi@74 | 484 | 
| devi@74 | 485                 { | 
| devi@74 | 486                 use bytes; | 
| devi@74 | 487                 $cl{"raw_start"} = tell (FILE) - length($1); | 
| devi@74 | 488                 $cl{"raw_output_start"} = tell FILE; | 
| devi@74 | 489                 } | 
| devi@74 | 490                 $cl{"raw_file"} = $file; | 
| devi@74 | 491 | 
| devi@74 | 492                 $cl{"err"}      = 0; | 
| devi@74 | 493                 $cl{"output"}   = ""; | 
| devi@74 | 494                 #$cl{"tty"}     = $tty; | 
| devi@74 | 495 | 
| devi@74 | 496                 $cline_vt->process($cl{"raw_cline"}."\n"); | 
| devi@74 | 497                 $cl{"cline"}    = $cline_vt->row_plaintext (1); | 
| devi@74 | 498                 $cl{"cline"}    =~ s/\s*$//; | 
| devi@74 | 499                 $cline_vt->reset(); | 
| devi@74 | 500 | 
| devi@74 | 501                 my %commands    = extract_commands_from_cline($cl{"cline"}); | 
| devi@74 | 502                 #$cl{"euid"}     = 0 if defined $commands{"sudo"}; | 
| devi@74 | 503                 my @comms       = sort { $commands{$a} cmp $commands{$b} } keys %commands; | 
| devi@74 | 504                 $cl{"last_command"} | 
| devi@74 | 505                                 = $comms[$#comms] || ""; | 
| devi@74 | 506 | 
| devi@74 | 507                 if ( | 
| devi@74 | 508                     $Config{"suppress_editors"} =~ /^y/i | 
| devi@74 | 509                         && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}}) | 
| devi@74 | 510                     || $Config{"suppress_pagers"}  =~ /^y/i | 
| devi@74 | 511                         && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}}) | 
| devi@74 | 512                     || $Config{"suppress_terminal"}=~ /^y/i | 
| devi@74 | 513                         && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}}) | 
| devi@74 | 514                 ) { | 
| devi@74 | 515                     $cl{"suppress_output"} = "1"; | 
| devi@74 | 516                 } | 
| devi@74 | 517                 else { | 
| devi@74 | 518                     $cl{"suppress_output"} = "0"; | 
| devi@74 | 519                 } | 
| devi@74 | 520                 $skip_info = 0; | 
| devi@74 | 521 | 
| devi@74 | 522 | 
| devi@74 | 523                 if ($Config{verbose} =~ /y/i) { | 
| devi@83 | 524                     print "\n|   " if $commandlines_loaded % 5 == 1; | 
| devi@74 | 525                     print " ",$cl{"last_command"}; | 
| devi@74 | 526                 } | 
| devi@74 | 527 | 
| devi@74 | 528                 # Processing previous command line | 
| devi@74 | 529                 if ($first_pass) { | 
| devi@74 | 530                     $first_pass = 0; | 
| devi@74 | 531                     next; | 
| devi@74 | 532                 } | 
| devi@74 | 533 | 
| devi@74 | 534                 # Error code | 
| devi@74 | 535                 $last_cl{"err"}=$err; | 
| devi@74 | 536                 $last_cl{"raw_end"} = $cl{"raw_start"}; | 
| devi@74 | 537 | 
| devi@74 | 538                 if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) { | 
| devi@74 | 539                     bind_diff(\%last_cl); | 
| devi@74 | 540                 } | 
| devi@74 | 541 | 
| devi@74 | 542                 # Output | 
| devi@74 | 543                 if (!$last_cl{"suppress_output"} || $last_cl{"err"}) { | 
| devi@74 | 544                     for (my $i=0; $i<$Config{"terminal_height"}; $i++) { | 
| igor@115 | 545                         my $line= $vt{$local_session_id}->row_plaintext($i); | 
| devi@74 | 546                         next if !defined ($line) ; #|| $line =~ /^\s*$/; | 
| devi@74 | 547                         $line =~ s/\s*$//; | 
| devi@74 | 548                         $line .= "\n" unless $line =~ /^\s*$/; | 
| devi@74 | 549                         $last_cl{"output"} .= $line; | 
| devi@74 | 550                     } | 
| devi@74 | 551                 } | 
| devi@74 | 552                 else { | 
| devi@74 | 553                     $last_cl{"output"}= ""; | 
| devi@74 | 554                 } | 
| devi@74 | 555 | 
| igor@115 | 556                 $vt{$local_session_id}->reset(); | 
| devi@74 | 557 | 
| devi@74 | 558 | 
| devi@74 | 559                 # Changing encoding | 
| devi@74 | 560                 for (keys %last_cl) { | 
| devi@74 | 561                     next if /raw/; | 
| devi@74 | 562                     if ($Config{"encoding"} && | 
| devi@74 | 563                         $Config{"encoding"} !~ /^utf-8$/i) { | 
| devi@74 | 564                         $last_cl{$_} = $converter->convert($last_cl{$_}) | 
| devi@74 | 565                     } | 
| devi@74 | 566                 } | 
| devi@74 | 567                 push @Command_Lines, \%last_cl; | 
| devi@74 | 568 | 
| devi@74 | 569                 # Сохранение позиции в файле, до которой выполнен | 
| devi@74 | 570                 # успешный разбор | 
| devi@74 | 571                 $Script_Files{$file}->{tell} = $last_cl{raw_end}; | 
| devi@74 | 572 | 
| devi@74 | 573                 next; | 
| devi@74 | 574 | 
| devi@74 | 575             } | 
| devi@74 | 576 | 
| devi@74 | 577 # Иначе, это строка вывода | 
| devi@74 | 578 | 
| devi@62 | 579             $last_output_length+=length($_); | 
| devi@62 | 580             #if (!$cl{"suppress_output"} || $last_output_length < 5000) { | 
| devi@62 | 581             if ($last_output_length < 50000) { | 
| igor@115 | 582                 $vt{$local_session_id}->process("$_"."\n") | 
| devi@62 | 583             } | 
| devi@62 | 584             else | 
| devi@62 | 585             { | 
| devi@62 | 586                 if (!$skip_info) { | 
| devi@62 | 587                     print "($cl{last_command})"; | 
| devi@62 | 588                     $skip_info = 1; | 
| devi@62 | 589                 } | 
| devi@62 | 590             } | 
| devi@62 | 591         } | 
| devi@62 | 592         close(FILE); | 
| devi@23 | 593 | 
| devi@62 | 594     } | 
| devi@62 | 595     if ($Config{"verbose"} =~ /y/) { | 
| devi@74 | 596         print "\n`- finished.\n" ; | 
| devi@62 | 597         print "Lines loaded: $commandlines_processed\n"; | 
| devi@62 | 598         print "Command lines: $commandlines_loaded\n"; | 
| devi@62 | 599     } | 
| devi@23 | 600 } | 
| devi@23 | 601 | 
| devi@23 | 602 | 
| devi@23 | 603 | 
| devi@62 | 604 | 
| devi@62 | 605 sub sort_command_lines | 
| devi@62 | 606 { | 
| devi@74 | 607     print "Sorting command lines..." if $Config{"verbose"} =~ /y/; | 
| devi@62 | 608 | 
| devi@62 | 609     # Sort Command_Lines | 
| devi@62 | 610     # Write Command_Lines to Command_Lines_Index | 
| devi@62 | 611 | 
| devi@62 | 612     my @index; | 
| devi@62 | 613     for (my $i=0;$i<=$#Command_Lines;$i++) { | 
| devi@62 | 614         $index[$i]=$i; | 
| devi@62 | 615     } | 
| devi@62 | 616 | 
| devi@62 | 617     @Command_Lines_Index = sort { | 
| devi@86 | 618            defined($Command_Lines[$index[$a]]->{"time"}) | 
| devi@86 | 619         && defined($Command_Lines[$index[$b]]->{"time"}) | 
| devi@81 | 620         ?  $Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"} | 
| devi@84 | 621         :  defined($Command_Lines[$index[$a]]->{"day"}) | 
| devi@86 | 622            && defined($Command_Lines[$index[$b]]->{"day"}) | 
| devi@86 | 623            && defined($Command_Lines[$index[$a]]->{"hour"}) | 
| devi@86 | 624            && defined($Command_Lines[$index[$b]]->{"hour"}) | 
| devi@86 | 625            && defined($Command_Lines[$index[$a]]->{"min"}) | 
| devi@86 | 626            && defined($Command_Lines[$index[$b]]->{"min"}) | 
| devi@86 | 627            && defined($Command_Lines[$index[$a]]->{"sec"}) | 
| devi@86 | 628            && defined($Command_Lines[$index[$b]]->{"sec"}) | 
| devi@86 | 629            ?  $Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"} | 
| devi@86 | 630            || $Command_Lines[$index[$a]]->{"hour"} <=> $Command_Lines[$index[$b]]->{"hour"} | 
| devi@86 | 631            || $Command_Lines[$index[$a]]->{"min"} <=> $Command_Lines[$index[$b]]->{"min"} | 
| devi@86 | 632            || $Command_Lines[$index[$a]]->{"sec"} <=> $Command_Lines[$index[$b]]->{"sec"} | 
| devi@86 | 633            :  0 | 
| devi@62 | 634     } @index; | 
| devi@62 | 635 | 
| devi@74 | 636     print "finished\n" if $Config{"verbose"} =~ /y/; | 
| devi@62 | 637 | 
| devi@62 | 638 } | 
| devi@62 | 639 | 
| devi@23 | 640 sub printq | 
| devi@23 | 641 { | 
| devi@62 | 642     my $TO = shift; | 
| devi@62 | 643     my $text = join "", @_; | 
| devi@62 | 644     $text =~ s/&/&/g; | 
| devi@62 | 645     $text =~ s/</</g; | 
| devi@62 | 646     $text =~ s/>/>/g; | 
| devi@62 | 647     print $TO $text; | 
| devi@23 | 648 } | 
| devi@23 | 649 | 
| devi@23 | 650 | 
| devi@23 | 651 =cut | 
| devi@23 | 652 Вывести результат обработки журнала. | 
| devi@23 | 653 =cut | 
| devi@23 | 654 | 
| devi@23 | 655 sub print_command_lines | 
| devi@23 | 656 { | 
| devi@62 | 657     my $output_filename=$_[0]; | 
| devi@85 | 658     open(OUT, ">>", $output_filename) | 
| devi@62 | 659         or die "Can't open $output_filename for writing\n"; | 
| devi@23 | 660 | 
| devi@23 | 661 | 
| devi@62 | 662     my $cl; | 
| devi@62 | 663     my $in_range=0; | 
| devi@62 | 664     for my $i (@Command_Lines_Index) { | 
| devi@62 | 665         $cl = $Command_Lines[$i]; | 
| devi@23 | 666 | 
| devi@62 | 667         if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) { | 
| devi@62 | 668             $in_range=1; | 
| devi@62 | 669             next; | 
| devi@62 | 670         } | 
| devi@62 | 671         if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) { | 
| devi@62 | 672             $in_range=0; | 
| devi@62 | 673             next; | 
| devi@62 | 674         } | 
| devi@62 | 675         next if ($Config{"from"} && $Config{"to"} && !$in_range) | 
| devi@62 | 676             || | 
| devi@62 | 677                 ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ ) | 
| devi@62 | 678             || | 
| devi@62 | 679             ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0) | 
| devi@62 | 680             || | 
| devi@62 | 681             ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130); | 
| devi@62 | 682 | 
| devi@62 | 683         # Вырезаем из вывода только нужное количество строк | 
| devi@23 | 684 | 
| devi@62 | 685         my $output=""; | 
| devi@69 | 686 | 
| devi@73 | 687         if (!grep ($_ eq $cl->{"last_command"}, @{$Config{"full_output_commands"}}) | 
| devi@69 | 688             && ($Config{"head_lines"} | 
| devi@73 | 689             || $Config{"tail_lines"})) { | 
| devi@62 | 690             # Partialy output | 
| devi@62 | 691             my @lines = split '\n', $cl->{"output"}; | 
| devi@62 | 692             # head | 
| devi@62 | 693             my $mark=1; | 
| devi@62 | 694             for (my $i=0; $i<= $#lines && $i < $Config{"cache_head_lines"}; $i++) { | 
| devi@62 | 695                 $output .= $lines[$i]."\n"; | 
| devi@62 | 696             } | 
| devi@62 | 697             # tail | 
| devi@62 | 698             my $start=$#lines-$Config{"cache_tail_lines"}+1; | 
| devi@62 | 699             if ($start < 0) { | 
| devi@62 | 700                 $start=0; | 
| devi@62 | 701                 $mark=0; | 
| devi@62 | 702             } | 
| devi@62 | 703             if ($start < $Config{"cache_head_lines"}) { | 
| devi@62 | 704                 $start=$Config{"cache_head_lines"}; | 
| devi@62 | 705                 $mark=0; | 
| devi@62 | 706             } | 
| devi@62 | 707             $output .= $Config{"skip_text"}."\n" if $mark; | 
| devi@73 | 708             for ($i=$start; $i<= $#lines; $i++) { | 
| devi@62 | 709                 $output .= $lines[$i]."\n"; | 
| devi@62 | 710             } | 
| devi@62 | 711         } | 
| devi@62 | 712         else { | 
| devi@62 | 713             # Full output | 
| devi@62 | 714             $output .= $cl->{"output"}; | 
| devi@62 | 715         } | 
| devi@23 | 716 | 
| devi@62 | 717         # Совместимость с labmaker | 
| devi@23 | 718 | 
| devi@62 | 719         # Переводим в секунды Эпохи | 
| devi@62 | 720         # В labmaker'е данные хранились в неудобной форме: hour, min, sec, day of year | 
| devi@62 | 721         # Информация о годе отсутствовала | 
| devi@62 | 722         # Её можно внести: | 
| devi@62 | 723         # Декабрь 2004 год; остальные -- 2005 год. | 
| devi@23 | 724 | 
| devi@62 | 725         my $year = 2005; | 
| devi@62 | 726         #$year = 2004 if ( $cl->{day} > 330 ); | 
| devi@62 | 727         $year = $Config{year} if $Config{year}; | 
| devi@62 | 728         # timelocal(            $sec,      $min,      $hour,      $mday,$mon,$year); | 
| devi@74 | 729         $cl->{time} ||= timelocal_nocheck($cl->{sec},$cl->{min},$cl->{hour},$cl->{day},0,$year); | 
| devi@23 | 730 | 
| devi@23 | 731 | 
| devi@62 | 732         # Начинаем вывод команды | 
| devi@62 | 733         print OUT "<command>\n"; | 
| devi@98 | 734         print OUT "<l3cd>$Config{l3cd}</l3cd>\n" if $Config{"l3cd"}; | 
| devi@62 | 735         for my $element (qw( | 
| devi@62 | 736             local_session_id | 
| devi@74 | 737             history | 
| devi@74 | 738             uid | 
| devi@74 | 739             pid | 
| devi@62 | 740             time | 
| devi@74 | 741             pwd | 
| devi@62 | 742             raw_start | 
| devi@62 | 743             raw_output_start | 
| devi@62 | 744             raw_end | 
| devi@62 | 745             raw_file | 
| devi@62 | 746             tty | 
| devi@62 | 747             err | 
| devi@62 | 748             last_command | 
| devi@74 | 749             history | 
| devi@62 | 750             )) { | 
| devi@65 | 751             next unless defined($cl->{"$element"}); | 
| devi@62 | 752             print OUT "<$element>".$cl->{$element}."</$element>\n"; | 
| devi@62 | 753         } | 
| devi@62 | 754         for my $element (qw( | 
| devi@62 | 755             prompt | 
| devi@62 | 756             cline | 
| devi@62 | 757             )) { | 
| devi@65 | 758             next unless defined($cl->{"$element"}); | 
| devi@62 | 759             print OUT "<$element>"; | 
| devi@62 | 760             printq(\*OUT,$cl->{"$element"}); | 
| devi@62 | 761             print OUT "</$element>\n"; | 
| devi@62 | 762         } | 
| devi@72 | 763             #note | 
| devi@72 | 764             #note_title | 
| devi@62 | 765         print OUT "<output>"; | 
| devi@62 | 766         printq(\*OUT,$output); | 
| devi@62 | 767         print OUT "</output>\n"; | 
| devi@62 | 768         if ($cl->{"diff"}) { | 
| devi@62 | 769             print OUT "<diff>"; | 
| devi@62 | 770             printq(\*OUT,${$Diffs{$cl->{"diff"}}}{"text"}); | 
| devi@62 | 771             print OUT "</diff>\n"; | 
| devi@62 | 772         } | 
| devi@62 | 773         print OUT "</command>\n"; | 
| devi@23 | 774 | 
| devi@62 | 775     } | 
| devi@23 | 776 | 
| devi@62 | 777     close(OUT); | 
| devi@27 | 778 } | 
| devi@27 | 779 | 
| devi@27 | 780 sub print_session | 
| devi@27 | 781 { | 
| devi@62 | 782     my $output_filename = $_[0]; | 
| devi@62 | 783     my $local_session_id = $_[1]; | 
| devi@62 | 784     return if not defined($Sessions{$local_session_id}); | 
| devi@27 | 785 | 
| devi@84 | 786     print "printing session info. session id = ".$local_session_id."\n" | 
| devi@84 | 787         if $Config{verbose} =~ /y/; | 
| devi@84 | 788 | 
| devi@62 | 789     open(OUT, ">>", $output_filename) | 
| devi@62 | 790         or die "Can't open $output_filename for writing\n"; | 
| devi@62 | 791     print OUT "<session>\n"; | 
| devi@98 | 792     print OUT "<l3cd>$Config{l3cd}</l3cd>\n" if $Config{"l3cd"}; | 
| devi@62 | 793     my %session = %{$Sessions{$local_session_id}}; | 
| devi@62 | 794     for my $key (keys %session) { | 
| devi@84 | 795         print OUT "<$key>".$session{$key}."</$key>\n"; | 
| devi@84 | 796         print "         ".$key,"\n"; | 
| devi@62 | 797     } | 
| devi@62 | 798     print OUT "</session>\n"; | 
| devi@62 | 799     close(OUT); | 
| devi@27 | 800 } | 
| devi@27 | 801 | 
| devi@27 | 802 sub send_cache | 
| devi@27 | 803 { | 
| devi@62 | 804     # Если в кэше что-то накопилось, | 
| devi@62 | 805     # попытаемся отправить это на сервер | 
| devi@62 | 806     # | 
| devi@62 | 807     my $cache_was_sent=0; | 
| devi@62 | 808 | 
| devi@62 | 809     if (open(CACHE, $Config{cache})) { | 
| devi@62 | 810         local $/; | 
| devi@62 | 811         my $cache = <CACHE>; | 
| devi@62 | 812         close(CACHE); | 
| devi@27 | 813 | 
| devi@62 | 814         my $socket = IO::Socket::INET->new( | 
| devi@62 | 815                             PeerAddr => $Config{backend_address}, | 
| devi@62 | 816                             PeerPort => $Config{backend_port}, | 
| devi@62 | 817                             proto   => "tcp", | 
| devi@62 | 818                             Type    => SOCK_STREAM | 
| devi@62 | 819                         ); | 
| devi@27 | 820 | 
| devi@62 | 821         if ($socket) { | 
| devi@62 | 822             print $socket $cache; | 
| devi@62 | 823             close($socket); | 
| devi@62 | 824             $cache_was_sent = 1; | 
| devi@62 | 825         } | 
| devi@62 | 826     } | 
| devi@62 | 827     return $cache_was_sent; | 
| devi@23 | 828 } | 
| devi@23 | 829 | 
| devi@25 | 830 sub save_cache_stat | 
| devi@25 | 831 { | 
| devi@62 | 832     open (CACHE, ">$Config{cache_stat}"); | 
| devi@62 | 833     for my $f (keys %Script_Files) { | 
| devi@62 | 834         print CACHE "$f\t",$Script_Files{$f}->{size},"\t",$Script_Files{$f}->{tell},"\n"; | 
| devi@62 | 835     } | 
| devi@62 | 836     close(CACHE); | 
| devi@25 | 837 } | 
| devi@25 | 838 | 
| devi@25 | 839 sub load_cache_stat | 
| devi@25 | 840 { | 
| devi@62 | 841     if (open (CACHE, "$Config{cache_stat}")) { | 
| devi@62 | 842         while(<CACHE>) { | 
| devi@62 | 843             chomp; | 
| devi@62 | 844             my ($f, $size, $tell) = split /\t/; | 
| devi@62 | 845             $Script_Files{$f}->{size} = $size; | 
| devi@62 | 846             $Script_Files{$f}->{tell} = $tell; | 
| devi@62 | 847         } | 
| devi@62 | 848         close(CACHE); | 
| devi@62 | 849     }; | 
| devi@25 | 850 } | 
| devi@23 | 851 | 
| devi@23 | 852 | 
| devi@23 | 853 main(); | 
| devi@23 | 854 | 
| devi@25 | 855 sub process_was_killed | 
| devi@25 | 856 { | 
| devi@62 | 857     $Killed = 1; | 
| devi@25 | 858 } | 
| devi@25 | 859 | 
| devi@98 | 860 sub reload | 
| devi@98 | 861 { | 
| devi@98 | 862     init_config; | 
| devi@98 | 863 } | 
| devi@98 | 864 | 
| devi@23 | 865 sub main | 
| devi@23 | 866 { | 
| devi@23 | 867 | 
| devi@62 | 868     $| = 1; | 
| devi@23 | 869 | 
| devi@62 | 870     init_variables(); | 
| devi@62 | 871     init_config(); | 
| devi@23 | 872 | 
| devi@27 | 873 | 
| devi@62 | 874     if ($Config{"mode"} ne "daemon") { | 
| devi@27 | 875 | 
| devi@74 | 876 #    В нормальном режиме работы нужно | 
| devi@74 | 877 #    считать скрипты, обработать их и записать | 
| devi@74 | 878 #    результат выполнения в результирующий файл. | 
| devi@74 | 879 #    После этого завершить работу. | 
| devi@74 | 880 | 
| devi@85 | 881 # Очистим кэш-файл, если он существовал | 
| devi@85 | 882         if (open (CACHE, ">", $Config{"cache"})) { | 
| devi@85 | 883             close(CACHE); | 
| devi@85 | 884         }; | 
| devi@62 | 885         for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) { | 
| devi@62 | 886             load_diff_files($lab_log); | 
| devi@62 | 887         } | 
| devi@62 | 888         load_command_lines($Config{"input"}, $Config{"input_mask"}); | 
| devi@67 | 889         sort_command_lines; | 
| devi@62 | 890         #process_command_lines; | 
| devi@62 | 891         print_command_lines($Config{"cache"}); | 
| devi@62 | 892     } | 
| devi@62 | 893     else { | 
| devi@62 | 894         if (open(PIDFILE, $Config{agent_pidfile})) { | 
| devi@62 | 895             my $pid = <PIDFILE>; | 
| devi@62 | 896             close(PIDFILE); | 
| devi@62 | 897             if ($^O eq 'linux' && $pid &&(! -e "/proc/$pid" || !`grep $Config{"l3-agent"} /proc/$pid/cmdline && grep "uid:.*\b$<\b" /proc/$pid/status`)) { | 
| devi@62 | 898                 print "Removing stale pidfile\n"; | 
| devi@62 | 899                 unlink $Config{agent_pidfile} | 
| devi@62 | 900                     or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!"; | 
| devi@62 | 901             } | 
| devi@108 | 902             elsif ($^O eq 'freebsd' && defined($pid) && $pid ne "" && not `ps axo uid,pid,command | grep '$< $pid $Config{"l3-agent"}' | grep -v grep 2> /dev/null`) { | 
| devi@62 | 903                 print "Removing stale pidfile\n"; | 
| devi@62 | 904                 unlink $Config{agent_pidfile} | 
| devi@62 | 905                     or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!"; | 
| devi@62 | 906             } | 
| devi@62 | 907             elsif ($^O eq 'linux' || $^O eq 'freebsd' ) { | 
| devi@62 | 908                 print "l3-agent is already running: pid=$pid; pidfile=$Config{agent_pidfile}\n"; | 
| devi@62 | 909                 exit(0); | 
| devi@62 | 910             } | 
| devi@62 | 911             else { | 
| devi@62 | 912                 print "Unknown operating system"; | 
| devi@62 | 913                 exit(0); | 
| devi@62 | 914             } | 
| devi@62 | 915         } | 
| devi@62 | 916         if ($Config{detach} =~ /^y/i) { | 
| devi@62 | 917             #$Config{verbose} = "no"; | 
| devi@62 | 918             my $pid = fork; | 
| devi@62 | 919             exit if $pid; | 
| devi@62 | 920             die "Couldn't fork: $!" unless defined ($pid); | 
| devi@27 | 921 | 
| devi@62 | 922             open(PIDFILE, ">", $Config{agent_pidfile}) | 
| devi@62 | 923                 or die "Can't open pidfile ". $Config{agent_pidfile}. " for wrting: $!"; | 
| devi@62 | 924             print PIDFILE $$; | 
| devi@62 | 925             close(PIDFILE); | 
| devi@27 | 926 | 
| devi@62 | 927             for my $handle (*STDIN, *STDOUT, *STDERR) { | 
| devi@62 | 928                 open ($handle, "+<", "/dev/null") | 
| devi@62 | 929                     or die "can't reopen $handle to /dev/null: $!" | 
| devi@62 | 930             } | 
| devi@27 | 931 | 
| devi@62 | 932             POSIX::setsid() | 
| devi@62 | 933                 or die "Can't start a new session: $!"; | 
| devi@27 | 934 | 
| devi@62 | 935             $0 = $Config{"l3-agent"}; | 
| devi@62 | 936 | 
| devi@98 | 937             $SIG{INT} = $SIG{TERM} = \&process_was_killed; | 
| devi@98 | 938             $SIG{HUP} = \&reload; | 
| devi@98 | 939 | 
| devi@62 | 940         } | 
| devi@62 | 941         while (not $Killed) { | 
| devi@62 | 942             @Command_Lines = (); | 
| devi@62 | 943             @Command_Lines_Index = (); | 
| devi@62 | 944             for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) { | 
| devi@62 | 945                 load_diff_files($lab_log); | 
| devi@62 | 946             } | 
| devi@62 | 947             load_cache_stat(); | 
| devi@62 | 948             load_command_lines($Config{"input"}, $Config{"input_mask"}); | 
| devi@62 | 949             if (@Command_Lines) { | 
| devi@74 | 950                 sort_command_lines; | 
| devi@65 | 951                 #process_command_lines; | 
| devi@62 | 952                 print_command_lines($Config{"cache"}); | 
| devi@62 | 953             } | 
| devi@62 | 954             save_cache_stat(); | 
| devi@62 | 955             if (-e $Config{cache} && (stat($Config{cache}))[7]) { | 
| devi@62 | 956                 send_cache() && unlink($Config{cache}); | 
| devi@62 | 957             } | 
| devi@62 | 958             sleep($Config{"daemon_sleep_interval"} || 1); | 
| devi@62 | 959         } | 
| devi@62 | 960 | 
| devi@62 | 961         unlink $Config{agent_pidfile}; | 
| devi@62 | 962     } | 
| devi@23 | 963 | 
| devi@23 | 964 } | 
| devi@23 | 965 | 
| devi@23 | 966 sub init_variables | 
| devi@23 | 967 { | 
| devi@23 | 968 } |