| 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; | 
| igor@150 | 347 	my $saved_output; | 
| devi@62 | 348         while (<FILE>) { | 
| devi@62 | 349             $commandlines_processed++; | 
| devi@23 | 350 | 
| devi@62 | 351             next if s/^Script started on.*?\n//s; | 
| devi@23 | 352 | 
| devi@62 | 353             if (/[0-9][0-9]:[0-9][0-9]:[0-9][0-9].\[[0-9][0-9]D.\[K/ && m/$cline_re/) { | 
| devi@62 | 354                 s/.*\x0d(?!\x0a)//; | 
| devi@62 | 355                 m/$cline_re2/gs; | 
| devi@23 | 356 | 
| devi@62 | 357                 $commandlines_loaded++; | 
| devi@62 | 358                 $last_output_length=0; | 
| devi@23 | 359 | 
| devi@62 | 360                 # Previous command | 
| devi@62 | 361                 my %last_cl = %cl; | 
| igor@119 | 362                 my $this_line = $1; | 
| devi@62 | 363                 my $err = $2 || ""; | 
| devi@23 | 364 | 
| devi@62 | 365                 $cl{"local_session_id"} = $local_session_id; | 
| devi@62 | 366                 # Parse new command | 
| devi@62 | 367                 $cl{"uid"} = $3; | 
| devi@74 | 368                 #$cl{"euid"} = $cl{"uid"};   # Если в команде обнаружится sudo, euid поменяем на 0 | 
| devi@62 | 369                 $cl{"pid"} = $4; | 
| devi@62 | 370                 $cl{"day"} = $5; | 
| devi@62 | 371                 $cl{"lab"} = $6; | 
| devi@62 | 372                 $cl{"hour"} = $7; | 
| devi@62 | 373                 $cl{"min"} = $8; | 
| devi@62 | 374                 $cl{"sec"} = $9; | 
| devi@72 | 375                 #$cl{"fullprompt"} = $10; | 
| devi@62 | 376                 $cl{"prompt"} = $11; | 
| devi@62 | 377                 $cl{"raw_cline"} = $12; | 
| devi@23 | 378 | 
| devi@62 | 379                 { | 
| devi@62 | 380                 use bytes; | 
| igor@119 | 381                 $cl{"raw_start"} = tell (FILE) - length($this_line); | 
| devi@62 | 382                 $cl{"raw_output_start"} = tell FILE; | 
| devi@62 | 383                 } | 
| devi@62 | 384                 $cl{"raw_file"} = $file; | 
| devi@23 | 385 | 
| devi@62 | 386                 $cl{"err"} = 0; | 
| devi@62 | 387                 $cl{"output"} = ""; | 
| devi@62 | 388                 $cl{"tty"} = $tty; | 
| devi@23 | 389 | 
| devi@62 | 390                 $cline_vt->process($cl{"raw_cline"}."\n"); | 
| devi@62 | 391                 $cl{"cline"} = $cline_vt->row_plaintext (1); | 
| devi@62 | 392                 $cl{"cline"} =~ s/\s*$//; | 
| igor@119 | 393                 $cl{"cline"} =~ s/.*?[\#\$]\s*//; | 
| devi@62 | 394                 $cline_vt->reset(); | 
| devi@23 | 395 | 
| devi@62 | 396                 my %commands = extract_commands_from_cline($cl{"cline"}); | 
| devi@74 | 397                 #$cl{"euid"}=0 if defined $commands{"sudo"}; | 
| devi@62 | 398                 my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands; | 
| devi@62 | 399                 $cl{"last_command"} = $comms[$#comms] || ""; | 
| devi@23 | 400 | 
| devi@62 | 401                 if ( | 
| devi@62 | 402                     $Config{"suppress_editors"} =~ /^y/i | 
| devi@62 | 403                         && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}}) | 
| devi@62 | 404                     || $Config{"suppress_pagers"}  =~ /^y/i | 
| devi@62 | 405                         && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}}) | 
| devi@62 | 406                     || $Config{"suppress_terminal"}=~ /^y/i | 
| devi@62 | 407                         && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}}) | 
| devi@62 | 408                 ) { | 
| devi@62 | 409                     $cl{"suppress_output"} = "1"; | 
| devi@62 | 410                 } | 
| devi@62 | 411                 else { | 
| devi@62 | 412                     $cl{"suppress_output"} = "0"; | 
| devi@62 | 413                 } | 
| devi@62 | 414                 $skip_info = 0; | 
| devi@23 | 415 | 
| devi@23 | 416 | 
| devi@62 | 417                 print " ",$cl{"last_command"}; | 
| devi@23 | 418 | 
| igor@119 | 419                 if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) { | 
| igor@119 | 420                     bind_diff(\%last_cl); | 
| igor@119 | 421                 } | 
| igor@119 | 422 | 
| devi@62 | 423                 # Error code | 
| devi@62 | 424                 $last_cl{"raw_end"} = $cl{"raw_start"}; | 
| devi@62 | 425                 $last_cl{"err"}=$err; | 
| devi@62 | 426                 $last_cl{"err"}=130 if $err eq "^C"; | 
| devi@23 | 427 | 
| devi@23 | 428 | 
| devi@62 | 429                 # Output | 
| devi@62 | 430                 if (!$last_cl{"suppress_output"} || $last_cl{"err"}) { | 
| devi@62 | 431                     for (my $i=0; $i<$Config{"terminal_height"}; $i++) { | 
| igor@115 | 432                         my $line= $vt{$local_session_id}->row_plaintext($i); | 
| devi@62 | 433                         next if !defined ($line) ; #|| $line =~ /^\s*$/; | 
| devi@62 | 434                         $line =~ s/\s*$//; | 
| devi@62 | 435                         $line .= "\n" unless $line =~ /^\s*$/; | 
| devi@62 | 436                         $last_cl{"output"} .= $line; | 
| devi@62 | 437                     } | 
| devi@62 | 438                 } | 
| devi@62 | 439                 else { | 
| devi@62 | 440                     $last_cl{"output"}= ""; | 
| devi@62 | 441                 } | 
| devi@23 | 442 | 
| igor@115 | 443                 $vt{$local_session_id}->reset(); | 
| devi@23 | 444 | 
| devi@23 | 445 | 
| devi@62 | 446                 # Save | 
| devi@62 | 447                 if (!$Config{"lab"} || $cl{"lab"} eq $Config{"lab"}) { | 
| devi@62 | 448                     # Changing encoding | 
| devi@62 | 449                     for (keys %last_cl) { | 
| devi@62 | 450                         next if /raw/; | 
| devi@62 | 451                         $last_cl{$_} = $converter->convert($last_cl{$_}) | 
| devi@62 | 452                             if ($Config{"encoding"} && | 
| devi@62 | 453                             $Config{"encoding"} !~ /^utf-8$/i); | 
| devi@62 | 454                     } | 
| devi@62 | 455                     push @Command_Lines, \%last_cl; | 
| devi@23 | 456 | 
| devi@62 | 457                     # Сохранение позиции в файле, до которой выполнен | 
| devi@62 | 458                     # успешный разбор | 
| devi@62 | 459                     $Script_Files{$file}->{tell} = $last_cl{raw_end}; | 
| devi@62 | 460                 } | 
| devi@62 | 461                 next; | 
| devi@62 | 462             } | 
| devi@74 | 463 | 
| igor@114 | 464             elsif (m/$cline_re_v2/ || m/$cline_re_v3/) { | 
| devi@74 | 465 # Разбираем командную строку версии 2 | 
| igor@119 | 466                 my $before=$_; | 
| igor@119 | 467                 s/.*\x0d(?!\x0a)//; | 
| devi@74 | 468 | 
| igor@114 | 469                 my $re; | 
| igor@114 | 470                 if (m/$cline_re_v2/) { | 
| igor@114 | 471                     $re=$cline_re2_v2; | 
| igor@114 | 472                 } | 
| igor@114 | 473                 else { | 
| igor@114 | 474                     s/.\[1K.\[10D//gs; | 
| igor@114 | 475                     $re=$cline_re2_v3; | 
| igor@119 | 476                     print STDERR "... $_ ...\n"; | 
| igor@114 | 477                 } | 
| igor@121 | 478                 m/$re/gs; | 
| devi@74 | 479 | 
| devi@74 | 480                 $commandlines_loaded++; | 
| devi@74 | 481                 $last_output_length=0; | 
| devi@74 | 482 | 
| devi@74 | 483                 # Previous command | 
| devi@74 | 484                 my %last_cl = %cl; | 
| devi@74 | 485 | 
| devi@74 | 486                 $cl{"local_session_id"} = $local_session_id; | 
| devi@74 | 487                 # Parse new command | 
| igor@119 | 488                 my $this_line = $1; | 
| devi@74 | 489                 $cl{"history"}  = $2; | 
| devi@74 | 490                 my $err         = $3; | 
| devi@74 | 491                 $cl{"uid"}      = $4; | 
| devi@74 | 492                 #$cl{"euid"}     = $cl{"uid"};   # Если в команде обнаружится sudo, euid поменяем на 0 | 
| devi@74 | 493                 $cl{"pid"}      = $5; | 
| devi@74 | 494                 $cl{"time"}     = $6; | 
| devi@74 | 495                 $cl{"pwd"}      = $7; | 
| igor@119 | 496                 $cl{"nonce"}    = $8; | 
| devi@74 | 497                 #$cl{"fullprompt"} = $8; | 
| igor@119 | 498                 $cl{"prompt"}   = $10; | 
| igor@119 | 499                 #$cl{"raw_cline"}= $10; | 
| igor@119 | 500                 $cl{"raw_cline"}= $before; | 
| devi@74 | 501 | 
| devi@74 | 502                 { | 
| devi@74 | 503                 use bytes; | 
| igor@119 | 504                 $cl{"raw_start"} = tell (FILE) - length($before); | 
| devi@74 | 505                 $cl{"raw_output_start"} = tell FILE; | 
| devi@74 | 506                 } | 
| devi@74 | 507                 $cl{"raw_file"} = $file; | 
| devi@74 | 508 | 
| devi@74 | 509                 $cl{"err"}      = 0; | 
| devi@74 | 510                 $cl{"output"}   = ""; | 
| devi@74 | 511                 #$cl{"tty"}     = $tty; | 
| devi@74 | 512 | 
| devi@74 | 513                 $cline_vt->process($cl{"raw_cline"}."\n"); | 
| devi@74 | 514                 $cl{"cline"}    = $cline_vt->row_plaintext (1); | 
| devi@74 | 515                 $cl{"cline"}    =~ s/\s*$//; | 
| igor@119 | 516                 $cl{"cline"} =~ s/.*?[\#\$]\s*//; | 
| devi@74 | 517                 $cline_vt->reset(); | 
| igor@119 | 518                 print STDERR "cline=".$cl{"cline"}."<<\n"; | 
| devi@74 | 519 | 
| devi@74 | 520                 my %commands    = extract_commands_from_cline($cl{"cline"}); | 
| devi@74 | 521                 #$cl{"euid"}     = 0 if defined $commands{"sudo"}; | 
| devi@74 | 522                 my @comms       = sort { $commands{$a} cmp $commands{$b} } keys %commands; | 
| devi@74 | 523                 $cl{"last_command"} | 
| devi@74 | 524                                 = $comms[$#comms] || ""; | 
| devi@74 | 525 | 
| igor@119 | 526                 print STDERR "last_command=".$cl{"last_command"}."<<\n"; | 
| igor@119 | 527 | 
| devi@74 | 528                 if ( | 
| devi@74 | 529                     $Config{"suppress_editors"} =~ /^y/i | 
| devi@74 | 530                         && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}}) | 
| devi@74 | 531                     || $Config{"suppress_pagers"}  =~ /^y/i | 
| devi@74 | 532                         && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}}) | 
| devi@74 | 533                     || $Config{"suppress_terminal"}=~ /^y/i | 
| devi@74 | 534                         && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}}) | 
| devi@74 | 535                 ) { | 
| devi@74 | 536                     $cl{"suppress_output"} = "1"; | 
| devi@74 | 537                 } | 
| devi@74 | 538                 else { | 
| devi@74 | 539                     $cl{"suppress_output"} = "0"; | 
| devi@74 | 540                 } | 
| devi@74 | 541                 $skip_info = 0; | 
| devi@74 | 542 | 
| devi@74 | 543                 if ($Config{verbose} =~ /y/i) { | 
| devi@83 | 544                     print "\n|   " if $commandlines_loaded % 5 == 1; | 
| devi@74 | 545                     print " ",$cl{"last_command"}; | 
| devi@74 | 546                 } | 
| devi@74 | 547 | 
| igor@119 | 548                 if (defined($last_cl{time}) | 
| igor@119 | 549                     && grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) { | 
| igor@119 | 550                        bind_diff(\%last_cl); | 
| devi@74 | 551                 } | 
| devi@74 | 552 | 
| devi@74 | 553                 # Error code | 
| devi@74 | 554                 $last_cl{"err"}=$err; | 
| devi@74 | 555                 $last_cl{"raw_end"} = $cl{"raw_start"}; | 
| devi@74 | 556 | 
| devi@74 | 557                 # Output | 
| devi@74 | 558                 if (!$last_cl{"suppress_output"} || $last_cl{"err"}) { | 
| igor@150 | 559                     $last_cl{"output"}=$saved_output; | 
| devi@74 | 560                     for (my $i=0; $i<$Config{"terminal_height"}; $i++) { | 
| igor@115 | 561                         my $line= $vt{$local_session_id}->row_plaintext($i); | 
| devi@74 | 562                         next if !defined ($line) ; #|| $line =~ /^\s*$/; | 
| devi@74 | 563                         $line =~ s/\s*$//; | 
| devi@74 | 564                         $line .= "\n" unless $line =~ /^\s*$/; | 
| devi@74 | 565                         $last_cl{"output"} .= $line; | 
| devi@74 | 566                     } | 
| devi@74 | 567                 } | 
| devi@74 | 568                 else { | 
| devi@74 | 569                     $last_cl{"output"}= ""; | 
| devi@74 | 570                 } | 
| devi@74 | 571 | 
| igor@115 | 572                 $vt{$local_session_id}->reset(); | 
| igor@150 | 573 		$saved_output=""; | 
| devi@74 | 574 | 
| devi@74 | 575 | 
| devi@74 | 576                 # Changing encoding | 
| devi@74 | 577                 for (keys %last_cl) { | 
| devi@74 | 578                     next if /raw/; | 
| devi@74 | 579                     if ($Config{"encoding"} && | 
| devi@74 | 580                         $Config{"encoding"} !~ /^utf-8$/i) { | 
| devi@74 | 581                         $last_cl{$_} = $converter->convert($last_cl{$_}) | 
| devi@74 | 582                     } | 
| devi@74 | 583                 } | 
| igor@119 | 584                 if (defined($last_cl{time})) { | 
| igor@119 | 585                     print STDERR "push id=".$last_cl{time}."\n"; | 
| igor@119 | 586                     push @Command_Lines, \%last_cl; | 
| igor@119 | 587                     # Сохранение позиции в файле, до которой выполнен | 
| igor@119 | 588                     # успешный разбор | 
| igor@119 | 589                     $Script_Files{$file}->{tell} = $last_cl{raw_end}; | 
| igor@119 | 590                 } | 
| devi@74 | 591                 next; | 
| devi@74 | 592             } | 
| devi@74 | 593 | 
| igor@150 | 594             if (($commandlines_processed%100) == 0) { | 
| igor@150 | 595 # Каждые сто строк обнуляем терминал и переносим вывод из него в кэш | 
| igor@150 | 596                 # Output | 
| igor@150 | 597 	        for (my $i=0; $i<$Config{"terminal_height"}; $i++) { | 
| igor@150 | 598 	   	    my $line= $vt{$local_session_id}->row_plaintext($i); | 
| igor@150 | 599 		    next if !defined ($line) ; #|| $line =~ /^\s*$/; | 
| igor@150 | 600 		    $line =~ s/\s*$//; | 
| igor@150 | 601 		    $line .= "\n" unless $line =~ /^\s*$/; | 
| igor@150 | 602 		    $saved_output .= $line; | 
| igor@150 | 603 	        } | 
| igor@150 | 604                 $vt{$local_session_id}->reset(); | 
| igor@150 | 605                 $last_output_length=0; | 
| igor@150 | 606 	    } | 
| igor@150 | 607 | 
| devi@74 | 608 # Иначе, это строка вывода | 
| devi@74 | 609 | 
| devi@62 | 610             $last_output_length+=length($_); | 
| devi@62 | 611             #if (!$cl{"suppress_output"} || $last_output_length < 5000) { | 
| devi@62 | 612             if ($last_output_length < 50000) { | 
| igor@115 | 613                 $vt{$local_session_id}->process("$_"."\n") | 
| devi@62 | 614             } | 
| devi@62 | 615             else | 
| devi@62 | 616             { | 
| igor@119 | 617                 if (!$skip_info && defined($cl{last_command})) { | 
| devi@62 | 618                     print "($cl{last_command})"; | 
| devi@62 | 619                     $skip_info = 1; | 
| devi@62 | 620                 } | 
| devi@62 | 621             } | 
| devi@62 | 622         } | 
| devi@62 | 623         close(FILE); | 
| devi@23 | 624 | 
| devi@62 | 625     } | 
| devi@62 | 626     if ($Config{"verbose"} =~ /y/) { | 
| devi@74 | 627         print "\n`- finished.\n" ; | 
| devi@62 | 628         print "Lines loaded: $commandlines_processed\n"; | 
| devi@62 | 629         print "Command lines: $commandlines_loaded\n"; | 
| devi@62 | 630     } | 
| devi@23 | 631 } | 
| devi@23 | 632 | 
| devi@23 | 633 | 
| devi@23 | 634 | 
| devi@62 | 635 | 
| devi@62 | 636 sub sort_command_lines | 
| devi@62 | 637 { | 
| devi@74 | 638     print "Sorting command lines..." if $Config{"verbose"} =~ /y/; | 
| devi@62 | 639 | 
| devi@62 | 640     # Sort Command_Lines | 
| devi@62 | 641     # Write Command_Lines to Command_Lines_Index | 
| devi@62 | 642 | 
| devi@62 | 643     my @index; | 
| devi@62 | 644     for (my $i=0;$i<=$#Command_Lines;$i++) { | 
| devi@62 | 645         $index[$i]=$i; | 
| devi@62 | 646     } | 
| devi@62 | 647 | 
| devi@62 | 648     @Command_Lines_Index = sort { | 
| devi@86 | 649            defined($Command_Lines[$index[$a]]->{"time"}) | 
| devi@86 | 650         && defined($Command_Lines[$index[$b]]->{"time"}) | 
| devi@81 | 651         ?  $Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"} | 
| devi@84 | 652         :  defined($Command_Lines[$index[$a]]->{"day"}) | 
| devi@86 | 653            && defined($Command_Lines[$index[$b]]->{"day"}) | 
| devi@86 | 654            && defined($Command_Lines[$index[$a]]->{"hour"}) | 
| devi@86 | 655            && defined($Command_Lines[$index[$b]]->{"hour"}) | 
| devi@86 | 656            && defined($Command_Lines[$index[$a]]->{"min"}) | 
| devi@86 | 657            && defined($Command_Lines[$index[$b]]->{"min"}) | 
| devi@86 | 658            && defined($Command_Lines[$index[$a]]->{"sec"}) | 
| devi@86 | 659            && defined($Command_Lines[$index[$b]]->{"sec"}) | 
| devi@86 | 660            ?  $Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"} | 
| devi@86 | 661            || $Command_Lines[$index[$a]]->{"hour"} <=> $Command_Lines[$index[$b]]->{"hour"} | 
| devi@86 | 662            || $Command_Lines[$index[$a]]->{"min"} <=> $Command_Lines[$index[$b]]->{"min"} | 
| devi@86 | 663            || $Command_Lines[$index[$a]]->{"sec"} <=> $Command_Lines[$index[$b]]->{"sec"} | 
| devi@86 | 664            :  0 | 
| devi@62 | 665     } @index; | 
| devi@62 | 666 | 
| devi@74 | 667     print "finished\n" if $Config{"verbose"} =~ /y/; | 
| devi@62 | 668 | 
| devi@62 | 669 } | 
| devi@62 | 670 | 
| devi@23 | 671 sub printq | 
| devi@23 | 672 { | 
| devi@62 | 673     my $TO = shift; | 
| devi@62 | 674     my $text = join "", @_; | 
| devi@62 | 675     $text =~ s/&/&/g; | 
| devi@62 | 676     $text =~ s/</</g; | 
| devi@62 | 677     $text =~ s/>/>/g; | 
| devi@62 | 678     print $TO $text; | 
| devi@23 | 679 } | 
| devi@23 | 680 | 
| devi@23 | 681 | 
| devi@23 | 682 =cut | 
| devi@23 | 683 Вывести результат обработки журнала. | 
| devi@23 | 684 =cut | 
| devi@23 | 685 | 
| devi@23 | 686 sub print_command_lines | 
| devi@23 | 687 { | 
| devi@62 | 688     my $output_filename=$_[0]; | 
| devi@85 | 689     open(OUT, ">>", $output_filename) | 
| devi@62 | 690         or die "Can't open $output_filename for writing\n"; | 
| devi@23 | 691 | 
| devi@23 | 692 | 
| devi@62 | 693     my $cl; | 
| devi@62 | 694     my $in_range=0; | 
| devi@62 | 695     for my $i (@Command_Lines_Index) { | 
| devi@62 | 696         $cl = $Command_Lines[$i]; | 
| devi@23 | 697 | 
| devi@62 | 698         if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) { | 
| devi@62 | 699             $in_range=1; | 
| devi@62 | 700             next; | 
| devi@62 | 701         } | 
| devi@62 | 702         if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) { | 
| devi@62 | 703             $in_range=0; | 
| devi@62 | 704             next; | 
| devi@62 | 705         } | 
| devi@62 | 706         next if ($Config{"from"} && $Config{"to"} && !$in_range) | 
| devi@62 | 707             || | 
| devi@62 | 708                 ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ ) | 
| devi@62 | 709             || | 
| devi@62 | 710             ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0) | 
| devi@62 | 711             || | 
| devi@62 | 712             ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130); | 
| devi@62 | 713 | 
| devi@62 | 714         # Вырезаем из вывода только нужное количество строк | 
| devi@23 | 715 | 
| devi@62 | 716         my $output=""; | 
| devi@69 | 717 | 
| devi@73 | 718         if (!grep ($_ eq $cl->{"last_command"}, @{$Config{"full_output_commands"}}) | 
| devi@69 | 719             && ($Config{"head_lines"} | 
| devi@73 | 720             || $Config{"tail_lines"})) { | 
| devi@62 | 721             # Partialy output | 
| devi@62 | 722             my @lines = split '\n', $cl->{"output"}; | 
| devi@62 | 723             # head | 
| devi@62 | 724             my $mark=1; | 
| devi@62 | 725             for (my $i=0; $i<= $#lines && $i < $Config{"cache_head_lines"}; $i++) { | 
| devi@62 | 726                 $output .= $lines[$i]."\n"; | 
| devi@62 | 727             } | 
| devi@62 | 728             # tail | 
| devi@62 | 729             my $start=$#lines-$Config{"cache_tail_lines"}+1; | 
| devi@62 | 730             if ($start < 0) { | 
| devi@62 | 731                 $start=0; | 
| devi@62 | 732                 $mark=0; | 
| devi@62 | 733             } | 
| devi@62 | 734             if ($start < $Config{"cache_head_lines"}) { | 
| devi@62 | 735                 $start=$Config{"cache_head_lines"}; | 
| devi@62 | 736                 $mark=0; | 
| devi@62 | 737             } | 
| devi@62 | 738             $output .= $Config{"skip_text"}."\n" if $mark; | 
| devi@73 | 739             for ($i=$start; $i<= $#lines; $i++) { | 
| devi@62 | 740                 $output .= $lines[$i]."\n"; | 
| devi@62 | 741             } | 
| devi@62 | 742         } | 
| devi@62 | 743         else { | 
| devi@62 | 744             # Full output | 
| devi@62 | 745             $output .= $cl->{"output"}; | 
| devi@62 | 746         } | 
| devi@23 | 747 | 
| devi@62 | 748         # Совместимость с labmaker | 
| devi@23 | 749 | 
| devi@62 | 750         # Переводим в секунды Эпохи | 
| devi@62 | 751         # В labmaker'е данные хранились в неудобной форме: hour, min, sec, day of year | 
| devi@62 | 752         # Информация о годе отсутствовала | 
| devi@62 | 753         # Её можно внести: | 
| devi@62 | 754         # Декабрь 2004 год; остальные -- 2005 год. | 
| devi@23 | 755 | 
| devi@62 | 756         my $year = 2005; | 
| devi@62 | 757         #$year = 2004 if ( $cl->{day} > 330 ); | 
| devi@62 | 758         $year = $Config{year} if $Config{year}; | 
| devi@62 | 759         # timelocal(            $sec,      $min,      $hour,      $mday,$mon,$year); | 
| devi@74 | 760         $cl->{time} ||= timelocal_nocheck($cl->{sec},$cl->{min},$cl->{hour},$cl->{day},0,$year); | 
| devi@23 | 761 | 
| devi@23 | 762 | 
| devi@62 | 763         # Начинаем вывод команды | 
| devi@62 | 764         print OUT "<command>\n"; | 
| devi@98 | 765         print OUT "<l3cd>$Config{l3cd}</l3cd>\n" if $Config{"l3cd"}; | 
| devi@62 | 766         for my $element (qw( | 
| devi@62 | 767             local_session_id | 
| devi@74 | 768             history | 
| devi@74 | 769             uid | 
| devi@74 | 770             pid | 
| devi@62 | 771             time | 
| devi@74 | 772             pwd | 
| devi@62 | 773             raw_start | 
| devi@62 | 774             raw_output_start | 
| devi@62 | 775             raw_end | 
| devi@62 | 776             raw_file | 
| devi@62 | 777             tty | 
| devi@62 | 778             err | 
| devi@62 | 779             last_command | 
| devi@74 | 780             history | 
| igor@119 | 781             nonce | 
| devi@62 | 782             )) { | 
| devi@65 | 783             next unless defined($cl->{"$element"}); | 
| devi@62 | 784             print OUT "<$element>".$cl->{$element}."</$element>\n"; | 
| devi@62 | 785         } | 
| devi@62 | 786         for my $element (qw( | 
| devi@62 | 787             prompt | 
| devi@62 | 788             cline | 
| devi@62 | 789             )) { | 
| devi@65 | 790             next unless defined($cl->{"$element"}); | 
| devi@62 | 791             print OUT "<$element>"; | 
| devi@62 | 792             printq(\*OUT,$cl->{"$element"}); | 
| devi@62 | 793             print OUT "</$element>\n"; | 
| devi@62 | 794         } | 
| devi@72 | 795             #note | 
| devi@72 | 796             #note_title | 
| devi@62 | 797         print OUT "<output>"; | 
| devi@62 | 798         printq(\*OUT,$output); | 
| devi@62 | 799         print OUT "</output>\n"; | 
| devi@62 | 800         if ($cl->{"diff"}) { | 
| devi@62 | 801             print OUT "<diff>"; | 
| devi@62 | 802             printq(\*OUT,${$Diffs{$cl->{"diff"}}}{"text"}); | 
| devi@62 | 803             print OUT "</diff>\n"; | 
| devi@62 | 804         } | 
| devi@62 | 805         print OUT "</command>\n"; | 
| devi@23 | 806 | 
| devi@62 | 807     } | 
| devi@23 | 808 | 
| devi@62 | 809     close(OUT); | 
| devi@27 | 810 } | 
| devi@27 | 811 | 
| devi@27 | 812 sub print_session | 
| devi@27 | 813 { | 
| devi@62 | 814     my $output_filename = $_[0]; | 
| devi@62 | 815     my $local_session_id = $_[1]; | 
| devi@62 | 816     return if not defined($Sessions{$local_session_id}); | 
| devi@27 | 817 | 
| devi@84 | 818     print "printing session info. session id = ".$local_session_id."\n" | 
| devi@84 | 819         if $Config{verbose} =~ /y/; | 
| devi@84 | 820 | 
| devi@62 | 821     open(OUT, ">>", $output_filename) | 
| devi@62 | 822         or die "Can't open $output_filename for writing\n"; | 
| devi@62 | 823     print OUT "<session>\n"; | 
| devi@98 | 824     print OUT "<l3cd>$Config{l3cd}</l3cd>\n" if $Config{"l3cd"}; | 
| devi@62 | 825     my %session = %{$Sessions{$local_session_id}}; | 
| devi@62 | 826     for my $key (keys %session) { | 
| devi@84 | 827         print OUT "<$key>".$session{$key}."</$key>\n"; | 
| devi@84 | 828         print "         ".$key,"\n"; | 
| devi@62 | 829     } | 
| devi@62 | 830     print OUT "</session>\n"; | 
| devi@62 | 831     close(OUT); | 
| devi@27 | 832 } | 
| devi@27 | 833 | 
| devi@27 | 834 sub send_cache | 
| devi@27 | 835 { | 
| devi@62 | 836     # Если в кэше что-то накопилось, | 
| devi@62 | 837     # попытаемся отправить это на сервер | 
| devi@62 | 838     # | 
| devi@62 | 839     my $cache_was_sent=0; | 
| devi@62 | 840 | 
| devi@62 | 841     if (open(CACHE, $Config{cache})) { | 
| devi@62 | 842         local $/; | 
| devi@62 | 843         my $cache = <CACHE>; | 
| devi@62 | 844         close(CACHE); | 
| devi@27 | 845 | 
| devi@62 | 846         my $socket = IO::Socket::INET->new( | 
| devi@62 | 847                             PeerAddr => $Config{backend_address}, | 
| devi@62 | 848                             PeerPort => $Config{backend_port}, | 
| devi@62 | 849                             proto   => "tcp", | 
| devi@62 | 850                             Type    => SOCK_STREAM | 
| devi@62 | 851                         ); | 
| devi@27 | 852 | 
| devi@62 | 853         if ($socket) { | 
| devi@62 | 854             print $socket $cache; | 
| devi@62 | 855             close($socket); | 
| devi@62 | 856             $cache_was_sent = 1; | 
| devi@62 | 857         } | 
| devi@62 | 858     } | 
| devi@62 | 859     return $cache_was_sent; | 
| devi@23 | 860 } | 
| devi@23 | 861 | 
| devi@25 | 862 sub save_cache_stat | 
| devi@25 | 863 { | 
| devi@62 | 864     open (CACHE, ">$Config{cache_stat}"); | 
| devi@62 | 865     for my $f (keys %Script_Files) { | 
| devi@62 | 866         print CACHE "$f\t",$Script_Files{$f}->{size},"\t",$Script_Files{$f}->{tell},"\n"; | 
| devi@62 | 867     } | 
| devi@62 | 868     close(CACHE); | 
| devi@25 | 869 } | 
| devi@25 | 870 | 
| devi@25 | 871 sub load_cache_stat | 
| devi@25 | 872 { | 
| devi@62 | 873     if (open (CACHE, "$Config{cache_stat}")) { | 
| devi@62 | 874         while(<CACHE>) { | 
| devi@62 | 875             chomp; | 
| devi@62 | 876             my ($f, $size, $tell) = split /\t/; | 
| devi@62 | 877             $Script_Files{$f}->{size} = $size; | 
| devi@62 | 878             $Script_Files{$f}->{tell} = $tell; | 
| devi@62 | 879         } | 
| devi@62 | 880         close(CACHE); | 
| devi@62 | 881     }; | 
| devi@25 | 882 } | 
| devi@23 | 883 | 
| devi@23 | 884 | 
| devi@23 | 885 main(); | 
| devi@23 | 886 | 
| devi@25 | 887 sub process_was_killed | 
| devi@25 | 888 { | 
| devi@62 | 889     $Killed = 1; | 
| devi@25 | 890 } | 
| devi@25 | 891 | 
| devi@98 | 892 sub reload | 
| devi@98 | 893 { | 
| devi@98 | 894     init_config; | 
| devi@98 | 895 } | 
| devi@98 | 896 | 
| devi@23 | 897 sub main | 
| devi@23 | 898 { | 
| devi@23 | 899 | 
| devi@62 | 900     $| = 1; | 
| devi@23 | 901 | 
| devi@62 | 902     init_variables(); | 
| devi@62 | 903     init_config(); | 
| devi@23 | 904 | 
| devi@27 | 905 | 
| devi@62 | 906     if ($Config{"mode"} ne "daemon") { | 
| devi@27 | 907 | 
| devi@74 | 908 #    В нормальном режиме работы нужно | 
| devi@74 | 909 #    считать скрипты, обработать их и записать | 
| devi@74 | 910 #    результат выполнения в результирующий файл. | 
| devi@74 | 911 #    После этого завершить работу. | 
| devi@74 | 912 | 
| devi@85 | 913 # Очистим кэш-файл, если он существовал | 
| devi@85 | 914         if (open (CACHE, ">", $Config{"cache"})) { | 
| devi@85 | 915             close(CACHE); | 
| devi@85 | 916         }; | 
| devi@62 | 917         load_command_lines($Config{"input"}, $Config{"input_mask"}); | 
| devi@67 | 918         sort_command_lines; | 
| devi@62 | 919         #process_command_lines; | 
| devi@62 | 920         print_command_lines($Config{"cache"}); | 
| devi@62 | 921     } | 
| devi@62 | 922     else { | 
| devi@62 | 923         if (open(PIDFILE, $Config{agent_pidfile})) { | 
| devi@62 | 924             my $pid = <PIDFILE>; | 
| devi@62 | 925             close(PIDFILE); | 
| devi@62 | 926             if ($^O eq 'linux' && $pid &&(! -e "/proc/$pid" || !`grep $Config{"l3-agent"} /proc/$pid/cmdline && grep "uid:.*\b$<\b" /proc/$pid/status`)) { | 
| devi@62 | 927                 print "Removing stale pidfile\n"; | 
| devi@62 | 928                 unlink $Config{agent_pidfile} | 
| devi@62 | 929                     or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!"; | 
| devi@62 | 930             } | 
| devi@108 | 931             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 | 932                 print "Removing stale pidfile\n"; | 
| devi@62 | 933                 unlink $Config{agent_pidfile} | 
| devi@62 | 934                     or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!"; | 
| devi@62 | 935             } | 
| devi@62 | 936             elsif ($^O eq 'linux' || $^O eq 'freebsd' ) { | 
| devi@62 | 937                 print "l3-agent is already running: pid=$pid; pidfile=$Config{agent_pidfile}\n"; | 
| devi@62 | 938                 exit(0); | 
| devi@62 | 939             } | 
| devi@62 | 940             else { | 
| devi@62 | 941                 print "Unknown operating system"; | 
| devi@62 | 942                 exit(0); | 
| devi@62 | 943             } | 
| devi@62 | 944         } | 
| devi@62 | 945         if ($Config{detach} =~ /^y/i) { | 
| devi@62 | 946             #$Config{verbose} = "no"; | 
| devi@62 | 947             my $pid = fork; | 
| devi@62 | 948             exit if $pid; | 
| devi@62 | 949             die "Couldn't fork: $!" unless defined ($pid); | 
| devi@27 | 950 | 
| devi@62 | 951             open(PIDFILE, ">", $Config{agent_pidfile}) | 
| devi@62 | 952                 or die "Can't open pidfile ". $Config{agent_pidfile}. " for wrting: $!"; | 
| devi@62 | 953             print PIDFILE $$; | 
| devi@62 | 954             close(PIDFILE); | 
| devi@27 | 955 | 
| devi@62 | 956             for my $handle (*STDIN, *STDOUT, *STDERR) { | 
| devi@62 | 957                 open ($handle, "+<", "/dev/null") | 
| devi@62 | 958                     or die "can't reopen $handle to /dev/null: $!" | 
| devi@62 | 959             } | 
| devi@27 | 960 | 
| devi@62 | 961             POSIX::setsid() | 
| devi@62 | 962                 or die "Can't start a new session: $!"; | 
| devi@27 | 963 | 
| devi@62 | 964             $0 = $Config{"l3-agent"}; | 
| devi@62 | 965 | 
| devi@98 | 966             $SIG{INT} = $SIG{TERM} = \&process_was_killed; | 
| devi@98 | 967             $SIG{HUP} = \&reload; | 
| devi@98 | 968 | 
| devi@62 | 969         } | 
| devi@62 | 970         while (not $Killed) { | 
| devi@62 | 971             @Command_Lines = (); | 
| devi@62 | 972             @Command_Lines_Index = (); | 
| devi@62 | 973             load_cache_stat(); | 
| devi@62 | 974             load_command_lines($Config{"input"}, $Config{"input_mask"}); | 
| devi@62 | 975             if (@Command_Lines) { | 
| devi@74 | 976                 sort_command_lines; | 
| devi@65 | 977                 #process_command_lines; | 
| devi@62 | 978                 print_command_lines($Config{"cache"}); | 
| devi@62 | 979             } | 
| devi@62 | 980             save_cache_stat(); | 
| devi@62 | 981             if (-e $Config{cache} && (stat($Config{cache}))[7]) { | 
| devi@62 | 982                 send_cache() && unlink($Config{cache}); | 
| devi@62 | 983             } | 
| devi@62 | 984             sleep($Config{"daemon_sleep_interval"} || 1); | 
| devi@62 | 985         } | 
| devi@62 | 986 | 
| devi@62 | 987         unlink $Config{agent_pidfile}; | 
| devi@62 | 988     } | 
| devi@23 | 989 | 
| devi@23 | 990 } | 
| devi@23 | 991 | 
| devi@23 | 992 sub init_variables | 
| devi@23 | 993 { | 
| devi@23 | 994 } |