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