lilalo
diff l3-agent @ 62:c4bea959dbb1
Beautyfication of l3-agent code. Many lines were erased. Need to be tested
| author | devi |
|---|---|
| date | Thu Jan 26 00:00:53 2006 +0200 (2006-01-26) |
| parents | 93e98a3fa44d |
| children | b7a217f8e963 |
line diff
1.1 --- a/l3-agent Sat Jan 14 00:12:41 2006 +0200 1.2 +++ b/l3-agent Thu Jan 26 00:00:53 2006 +0200 1.3 @@ -1,7 +1,7 @@ 1.4 #!/usr/bin/perl -w 1.5 1.6 # 1.7 -# (c) Igor Chubin, imchubin@mail.ru, 2004-2005 1.8 +# (c) Igor Chubin, igor@chub.in, 2004-2006 1.9 # 1.10 1.11 1.12 @@ -24,26 +24,22 @@ 1.13 our %Diffs; 1.14 our %Sessions; 1.15 1.16 -our %Commands_Stat; # Statistics about commands usage 1.17 -our %Files_Stat; # Statistics about commands usage 1.18 +our %Script_Files; # Информация о позициях в скрипт-файлах, 1.19 + # до которых уже выполнен разбор 1.20 + # и информация о времени модификации файла 1.21 + # $Script_Files{$file}->{size} 1.22 + # $Script_Files{$file}->{tell} 1.23 1.24 -our %Script_Files; # Информация о позициях в скрипт-файлах, 1.25 - # до которых уже выполнен разбор 1.26 - # и информация о времени модификации файла 1.27 - # $Script_Files{$file}->{size} 1.28 - # $Script_Files{$file}->{tell} 1.29 - 1.30 -our $Killed =0; # В режиме демона -- процесс получил сигнал о завершении 1.31 +our $Killed =0; # В режиме демона -- процесс получил сигнал о завершении 1.32 1.33 sub init_variables; 1.34 sub main; 1.35 1.36 sub load_diff_files; 1.37 sub bind_diff; 1.38 -sub extract_from_cline; 1.39 +sub extract_commands_from_cline; 1.40 sub load_command_lines; 1.41 sub sort_command_lines; 1.42 -sub process_command_lines; 1.43 sub print_command_lines; 1.44 sub printq; 1.45 1.46 @@ -53,20 +49,20 @@ 1.47 1.48 sub load_diff_files 1.49 { 1.50 - my @pathes = @_; 1.51 - 1.52 - for my $path (@pathes) { 1.53 - my $template = "*.diff"; 1.54 - my @files = <$path/$template>; 1.55 - my $i=0; 1.56 - for my $file (@files) { 1.57 + my @pathes = @_; 1.58 + 1.59 + for my $path (@pathes) { 1.60 + my $template = "*.diff"; 1.61 + my @files = <$path/$template>; 1.62 + my $i=0; 1.63 + for my $file (@files) { 1.64 1.65 - next if defined($Diffs{$file}); 1.66 - 1.67 - my %diff; 1.68 - 1.69 - $diff{"path"}=$path; 1.70 - $diff{"uid"}="SET THIS"; 1.71 + next if defined($Diffs{$file}); 1.72 + 1.73 + my %diff; 1.74 + 1.75 + $diff{"path"}=$path; 1.76 + $diff{"uid"}="SET THIS"; 1.77 1.78 # Сейчас UID определяется из названия каталога 1.79 # откуда берутся diff-файлы 1.80 @@ -77,634 +73,381 @@ 1.81 # мз которых и будет определяться соответствие 1.82 # имён пользователей их uid'ам 1.83 # 1.84 - $diff{"uid"} = 0 if $path =~ m@/root/@; 1.85 - 1.86 - $diff{"bind_to"}=""; 1.87 - $diff{"time_range"}=-1; 1.88 - 1.89 - next if not $file=~m@/(D?[0-9][0-9]?[0-9]?)[^/]*?([0-9]*):([0-9]*):?([0-9]*)@; 1.90 - $diff{"day"}=$1 || ""; 1.91 - $diff{"hour"}=$2; 1.92 - $diff{"min"}=$3; 1.93 - $diff{"sec"}=$4 || 0; 1.94 - 1.95 - $diff{"index"}=$i; 1.96 + $diff{"uid"} = 0 if $path =~ m@/root/@; 1.97 + 1.98 + $diff{"bind_to"}=""; 1.99 + $diff{"time_range"}=-1; 1.100 + 1.101 + next if not $file=~m@/(D?[0-9][0-9]?[0-9]?)[^/]*?([0-9]*):([0-9]*):?([0-9]*)@; 1.102 + $diff{"day"}=$1 || ""; 1.103 + $diff{"hour"}=$2; 1.104 + $diff{"min"}=$3; 1.105 + $diff{"sec"}=$4 || 0; 1.106 + 1.107 + $diff{"index"}=$i; 1.108 1.109 - print "diff loaded: $diff{day} $diff{hour}:$diff{min}:$diff{sec}\n"; 1.110 - 1.111 - local $/; 1.112 - open (F, "$file") 1.113 - or return "Can't open file $file ($_[0]) for reading"; 1.114 - my $text = <F>; 1.115 - if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i) { 1.116 - my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8"); 1.117 - $text = $converter->convert($text); 1.118 - } 1.119 - close(F); 1.120 - $diff{"text"}=$text; 1.121 - #print "$file loaded ($diff{day})\n"; 1.122 + print "diff loaded: $diff{day} $diff{hour}:$diff{min}:$diff{sec}\n"; 1.123 + 1.124 + local $/; 1.125 + open (F, "$file") 1.126 + or return "Can't open file $file ($_[0]) for reading"; 1.127 + my $text = <F>; 1.128 + if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i) { 1.129 + my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8"); 1.130 + $text = $converter->convert($text); 1.131 + } 1.132 + close(F); 1.133 + $diff{"text"}=$text; 1.134 + #print "$file loaded ($diff{day})\n"; 1.135 1.136 - #push @Diffs, \%diff; 1.137 - $Diffs{$file} = \%diff; 1.138 - $i++; 1.139 - } 1.140 - } 1.141 + #push @Diffs, \%diff; 1.142 + $Diffs{$file} = \%diff; 1.143 + $i++; 1.144 + } 1.145 + } 1.146 } 1.147 1.148 1.149 sub bind_diff 1.150 { 1.151 -# my $path = shift; 1.152 -# my $pid = shift; 1.153 -# my $day = shift; 1.154 -# my $lab = shift; 1.155 +# my $path = shift; 1.156 +# my $pid = shift; 1.157 +# my $day = shift; 1.158 +# my $lab = shift; 1.159 1.160 - print "Trying to bind diff...\n"; 1.161 + print "Trying to bind diff...\n"; 1.162 1.163 - my $cl = shift; 1.164 - my $hour = $cl->{"hour"}; 1.165 - my $min = $cl->{"min"}; 1.166 - my $sec = $cl->{"sec"}; 1.167 + my $cl = shift; 1.168 + my $hour = $cl->{"hour"}; 1.169 + my $min = $cl->{"min"}; 1.170 + my $sec = $cl->{"sec"}; 1.171 1.172 - my $min_dt = 10000; 1.173 + my $min_dt = 10000; 1.174 1.175 - for my $diff_key (keys %Diffs) { 1.176 - my $diff = $Diffs{$diff_key}; 1.177 - # Check here date, time and user 1.178 - next if ($diff->{"day"} && $cl->{"day"} && ($cl->{"day"} ne $diff->{"day"})); 1.179 - #next if (!$diff->{"uid"} && $cl->{"euid"} != $diff->{"uid"}); 1.180 - 1.181 - my $dt=($diff->{"hour"}-$hour)*3600 +($diff->{"min"}-$min)*60 + ($diff->{"sec"}-$sec); 1.182 - if ($dt >0 && $dt < $min_dt && ($diff->{"time_range"} <0 || $dt < $diff->{"time_range"})) { 1.183 - print "Approppriate diff found: dt=$dt\n"; 1.184 - if ($diff->{"bind_to"}) { 1.185 - undef $diff->{"bind_to"}->{"diff"}; 1.186 - }; 1.187 - $diff->{"time_range"}=$dt; 1.188 - $diff->{"bind_to"}=$cl; 1.189 + for my $diff_key (keys %Diffs) { 1.190 + my $diff = $Diffs{$diff_key}; 1.191 + # Check here date, time and user 1.192 + next if ($diff->{"day"} && $cl->{"day"} && ($cl->{"day"} ne $diff->{"day"})); 1.193 + #next if (!$diff->{"uid"} && $cl->{"euid"} != $diff->{"uid"}); 1.194 + 1.195 + my $dt=($diff->{"hour"}-$hour)*3600 +($diff->{"min"}-$min)*60 + ($diff->{"sec"}-$sec); 1.196 + if ($dt >0 && $dt < $min_dt && ($diff->{"time_range"} <0 || $dt < $diff->{"time_range"})) { 1.197 + print "Approppriate diff found: dt=$dt\n"; 1.198 + if ($diff->{"bind_to"}) { 1.199 + undef $diff->{"bind_to"}->{"diff"}; 1.200 + }; 1.201 + $diff->{"time_range"}=$dt; 1.202 + $diff->{"bind_to"}=$cl; 1.203 1.204 - #$cl->{"diff"} = $diff->{"index"}; 1.205 - $cl->{"diff"} = $diff_key; 1.206 - $min_dt = $dt; 1.207 - } 1.208 - 1.209 - } 1.210 + $cl->{"diff"} = $diff_key; 1.211 + $min_dt = $dt; 1.212 + } 1.213 + } 1.214 } 1.215 1.216 1.217 -sub extract_from_cline 1.218 +sub extract_commands_from_cline 1.219 # Разобрать командную строку $_[1] и возвратить хэш, содержащий 1.220 # номер первого появление команды в строке: 1.221 -# команда => первая позиция 1.222 +# команда => первая позиция 1.223 { 1.224 - my $what = $_[0]; 1.225 - my $cline = $_[1]; 1.226 - my @lists = split /\;/, $cline; 1.227 - 1.228 - 1.229 - my @commands = (); 1.230 - for my $list (@lists) { 1.231 - push @commands, split /\|/, $list; 1.232 - } 1.233 + my $cline = $_[0]; 1.234 + my @lists = split /\;/, $cline; 1.235 + 1.236 + 1.237 + my @commands = (); 1.238 + for my $list (@lists) { 1.239 + push @commands, split /\|/, $list; 1.240 + } 1.241 1.242 - my %commands; 1.243 - my %files; 1.244 - my $i=0; 1.245 - for my $command (@commands) { 1.246 - $command =~ /\s*(\S+)\s*(.*)/; 1.247 - if ($1 && $1 eq "sudo" ) { 1.248 - $commands{"$1"}=$i++; 1.249 - $command =~ s/\s*sudo\s+//; 1.250 - } 1.251 - $command =~ /\s*(\S+)\s*(.*)/; 1.252 - if ($1 && !defined $commands{"$1"}) { 1.253 - $commands{"$1"}=$i++; 1.254 - }; 1.255 - if ($2) { 1.256 - my $args = $2; 1.257 - my @args = split (/\s+/, $args); 1.258 - for my $a (@args) { 1.259 - $files{"$a"}=$i++ 1.260 - if !defined $files{"$a"}; 1.261 - }; 1.262 - 1.263 - 1.264 - } 1.265 - } 1.266 - 1.267 - if ($what eq "commands") { 1.268 - return %commands; 1.269 - } else { 1.270 - return %files; 1.271 - } 1.272 - 1.273 + my %commands; 1.274 + my %files; 1.275 + my $i=0; 1.276 + for my $command (@commands) { 1.277 + $command =~ /\s*(\S+)\s*(.*)/; 1.278 + if ($1 && $1 eq "sudo" ) { 1.279 + $commands{"$1"}=$i++; 1.280 + $command =~ s/\s*sudo\s+//; 1.281 + } 1.282 + $command =~ /\s*(\S+)\s*(.*)/; 1.283 + if ($1 && !defined $commands{"$1"}) { 1.284 + $commands{"$1"}=$i++; 1.285 + }; 1.286 + } 1.287 + return %commands; 1.288 } 1.289 1.290 sub load_command_lines 1.291 { 1.292 - my $lab_scripts_path = $_[0]; 1.293 - my $lab_scripts_mask = $_[1]; 1.294 + my $lab_scripts_path = $_[0]; 1.295 + my $lab_scripts_mask = $_[1]; 1.296 1.297 - my $cline_re_base = qq' 1.298 - ( 1.299 - (?:\\^?([0-9]*C?)) # exitcode 1.300 - (?:_([0-9]+)_)? # uid 1.301 - (?:_([0-9]+)_) # pid 1.302 - (...?) # day 1.303 - (.?.?) # lab 1.304 - \\s # space separator 1.305 - ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) # time 1.306 - .\\[50D.\\[K # killing symbols 1.307 - (.*?([\$\#]\\s?)) # prompt 1.308 - (.*) # command line 1.309 - ) 1.310 - '; 1.311 - #my $cline_re = qr/$cline_re_base(?:$cline_re_base|$)/x; 1.312 - #my $cline_re = qr/(?:$cline_re_base)*$cline_re_base$/x; 1.313 - my $cline_re = qr/$cline_re_base/sx; 1.314 - my $cline_re1 = qr/$cline_re_base\x0D/sx; 1.315 - my $cline_re2 = qr/$cline_re_base$/sx; 1.316 + my $cline_re_base = qq' 1.317 + ( 1.318 + (?:\\^?([0-9]*C?)) # exitcode 1.319 + (?:_([0-9]+)_)? # uid 1.320 + (?:_([0-9]+)_) # pid 1.321 + (...?) # day 1.322 + (.?.?) # lab 1.323 + \\s # space separator 1.324 + ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) # time 1.325 + .\\[50D.\\[K # killing symbols 1.326 + (.*?([\$\#]\\s?)) # prompt 1.327 + (.*) # command line 1.328 + ) 1.329 + '; 1.330 + #my $cline_re = qr/$cline_re_base(?:$cline_re_base|$)/x; 1.331 + #my $cline_re = qr/(?:$cline_re_base)*$cline_re_base$/x; 1.332 + my $cline_re = qr/$cline_re_base/sx; 1.333 + my $cline_re1 = qr/$cline_re_base\x0D/sx; 1.334 + my $cline_re2 = qr/$cline_re_base$/sx; 1.335 1.336 - my $vt = Term::VT102->new ( 'cols' => $Config{"terminal_width"}, 1.337 - 'rows' => $Config{"terminal_height"}); 1.338 - my $cline_vt = Term::VT102->new ('cols' => $Config{"terminal_width"}, 1.339 - 'rows' => $Config{"terminal_height"}); 1.340 + my $vt = Term::VT102->new ( 'cols' => $Config{"terminal_width"}, 1.341 + 'rows' => $Config{"terminal_height"}); 1.342 + my $cline_vt = Term::VT102->new ('cols' => $Config{"terminal_width"}, 1.343 + 'rows' => $Config{"terminal_height"}); 1.344 1.345 - my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8") 1.346 - if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i); 1.347 - 1.348 - print "Loading lm-scripts...\n" if $Config{"verbose"} =~ /y/; 1.349 + my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8") 1.350 + if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i); 1.351 + 1.352 + print "Loading lm-scripts...\n" if $Config{"verbose"} =~ /y/; 1.353 1.354 - my $file; 1.355 - my $skip_info; 1.356 + my $file; 1.357 + my $skip_info; 1.358 1.359 - my $commandlines_loaded =0; 1.360 - my $commandlines_processed =0; 1.361 + my $commandlines_loaded =0; 1.362 + my $commandlines_processed =0; 1.363 1.364 - my @lab_scripts = <$lab_scripts_path/$lab_scripts_mask>; 1.365 - for $file (@lab_scripts){ 1.366 - 1.367 - # Пропускаем файл, если он не изменялся со времени нашего предудущего прохода 1.368 - my $size = (stat($file))[7]; 1.369 - next if ($Script_Files{$file} && $Script_Files{$file}->{size} && $Script_Files{$file}->{size} >= $size); 1.370 + my @lab_scripts = <$lab_scripts_path/$lab_scripts_mask>; 1.371 + for $file (@lab_scripts){ 1.372 1.373 + # Пропускаем файл, если он не изменялся со времени нашего предудущего прохода 1.374 + my $size = (stat($file))[7]; 1.375 + next if ($Script_Files{$file} && $Script_Files{$file}->{size} && $Script_Files{$file}->{size} >= $size); 1.376 1.377 - my $local_session_id; 1.378 - # Начальное значение идентификатора текущего сеанса определяем из имени скрипта 1.379 - # Впоследствии оно может быть уточнено 1.380 - $file =~ m@.*/([^/]*)\.script$@; 1.381 - $local_session_id = $1; 1.382 1.383 - #Если файл только что появился, 1.384 - #пытаемся найти и загрузить информацию о соответствующей ему сессии 1.385 - if (!$Script_Files{$file}) { 1.386 - my $session_file = $file; 1.387 - $session_file =~ s/\.script/.info/; 1.388 - if (open(SESSION, $session_file)) { 1.389 - local $/; 1.390 - my $data = <SESSION>; 1.391 - close(SESSION); 1.392 + my $local_session_id; 1.393 + # Начальное значение идентификатора текущего сеанса определяем из имени скрипта 1.394 + # Впоследствии оно может быть уточнено 1.395 + $file =~ m@.*/([^/]*)\.script$@; 1.396 + $local_session_id = $1; 1.397 1.398 - for my $session_data ($data =~ m@<session>(.*?)</session>@sg) { 1.399 - my %session; 1.400 - while ($session_data =~ m@<([^>]*?)>(.*?)</\1>@sg) { 1.401 - $session{$1} = $2; 1.402 - } 1.403 - $local_session_id = $session{"local_session_id"} if $session{"local_session_id"}; 1.404 - $Sessions{$local_session_id}=\%session; 1.405 - } 1.406 + #Если файл только что появился, 1.407 + #пытаемся найти и загрузить информацию о соответствующей ему сессии 1.408 + if (!$Script_Files{$file}) { 1.409 + my $session_file = $file; 1.410 + $session_file =~ s/\.script/.info/; 1.411 + if (open(SESSION, $session_file)) { 1.412 + local $/; 1.413 + my $data = <SESSION>; 1.414 + close(SESSION); 1.415 1.416 - #Загруженную информацию сразу же отправляем в поток 1.417 - print_session($Config{cache}, $local_session_id); 1.418 - } 1.419 - } 1.420 - 1.421 - open (FILE, "$file"); 1.422 - binmode FILE; 1.423 - 1.424 - # Переходим к тому месту, где мы окончили разбор 1.425 - seek (FILE, $Script_Files{$file}->{tell}, 0) if $Script_Files{$file}->{tell}; 1.426 - $Script_Files{$file}->{size} = $size; 1.427 - $Script_Files{$file}->{tell} = 0 unless $Script_Files{$file}->{tell}; 1.428 + for my $session_data ($data =~ m@<session>(.*?)</session>@sg) { 1.429 + my %session; 1.430 + while ($session_data =~ m@<([^>]*?)>(.*?)</\1>@sg) { 1.431 + $session{$1} = $2; 1.432 + } 1.433 + $local_session_id = $session{"local_session_id"} if $session{"local_session_id"}; 1.434 + $Sessions{$local_session_id}=\%session; 1.435 + } 1.436 1.437 + #Загруженную информацию сразу же отправляем в поток 1.438 + print_session($Config{cache}, $local_session_id); 1.439 + } 1.440 + } 1.441 1.442 - $file =~ m@.*/(.*?)-.*@; 1.443 - 1.444 - my $tty = $1; 1.445 - my $first_pass = 1; 1.446 - my %cl; 1.447 - my $last_output_length=0; 1.448 - while (<FILE>) { 1.449 - 1.450 - $commandlines_processed++; 1.451 - # time 1.452 + open (FILE, "$file"); 1.453 + binmode FILE; 1.454 1.455 - next if s/^Script started on.*?\n//s; 1.456 + # Переходим к тому месту, где мы окончили разбор 1.457 + seek (FILE, $Script_Files{$file}->{tell}, 0) if $Script_Files{$file}->{tell}; 1.458 + $Script_Files{$file}->{size} = $size; 1.459 + $Script_Files{$file}->{tell} = 0 unless $Script_Files{$file}->{tell}; 1.460 1.461 - if (/[0-9][0-9]:[0-9][0-9]:[0-9][0-9].\[[0-9][0-9]D.\[K/ && m/$cline_re/) { 1.462 - s/.*\x0d(?!\x0a)//; 1.463 - # print "!!!",$_,"!!!\n"; 1.464 - # next; 1.465 - # while (m/$cline_re1/gs) { 1.466 - # } 1.467 - m/$cline_re2/gs; 1.468 + $file =~ m@.*/(.*?)-.*@; 1.469 1.470 - $commandlines_loaded++; 1.471 - $last_output_length=0; 1.472 + my $tty = $1; 1.473 + my $first_pass = 1; 1.474 + my %cl; 1.475 + my $last_output_length=0; 1.476 + while (<FILE>) { 1.477 + $commandlines_processed++; 1.478 1.479 - # Previous command 1.480 - my %last_cl = %cl; 1.481 - my $err = $2 || ""; 1.482 + next if s/^Script started on.*?\n//s; 1.483 1.484 + if (/[0-9][0-9]:[0-9][0-9]:[0-9][0-9].\[[0-9][0-9]D.\[K/ && m/$cline_re/) { 1.485 + s/.*\x0d(?!\x0a)//; 1.486 + m/$cline_re2/gs; 1.487 1.488 -=cut 1.489 + $commandlines_loaded++; 1.490 + $last_output_length=0; 1.491 1.492 -Атрибуты cline 1.493 -Список полей, характеризующих командную строку 1.494 + # Previous command 1.495 + my %last_cl = %cl; 1.496 + my $err = $2 || ""; 1.497 1.498 - uid 1.499 - Идентификатор пользователя 1.500 - 1.501 - tty 1.502 - Идентификатор терминала, на котором была вызвана команда 1.503 + $cl{"local_session_id"} = $local_session_id; 1.504 + # Parse new command 1.505 + $cl{"uid"} = $3; 1.506 + $cl{"euid"} = $cl{"uid"}; # Если в команде обнаружится sudo, euid поменяем на 0 1.507 + $cl{"pid"} = $4; 1.508 + $cl{"day"} = $5; 1.509 + $cl{"lab"} = $6; 1.510 + $cl{"hour"} = $7; 1.511 + $cl{"min"} = $8; 1.512 + $cl{"sec"} = $9; 1.513 + $cl{"fullprompt"} = $10; 1.514 + $cl{"prompt"} = $11; 1.515 + $cl{"raw_cline"} = $12; 1.516 1.517 - pid 1.518 - PID-процесса командного интерпретатора, 1.519 - в котором была вызвана команда 1.520 - 1.521 - lab 1.522 - лабораторная работа, к которой относится команда. 1.523 - Идентификатор текущей лабораторной работы 1.524 - хранится в файле ~/.labmaker/lab 1.525 + { 1.526 + use bytes; 1.527 + $cl{"raw_start"} = tell (FILE) - length($1); 1.528 + $cl{"raw_output_start"} = tell FILE; 1.529 + } 1.530 + $cl{"raw_file"} = $file; 1.531 1.532 - pwd (!) 1.533 - текущий каталог, из которого была вызвана команда 1.534 + $cl{"err"} = 0; 1.535 + $cl{"output"} = ""; 1.536 + $cl{"tty"} = $tty; 1.537 1.538 - day 1.539 - время вызова, день 1.540 - В действительности здесь хранится не время вызова команды, 1.541 - а с момента появления приглашения командного интерпретатора 1.542 - для ввода команды 1.543 - 1.544 - 1.545 - hour 1.546 - время вызова, час 1.547 - 1.548 - min 1.549 - время вызова, минута 1.550 - 1.551 - sec 1.552 - время вызова, секунда 1.553 - 1.554 - time (!) 1.555 - время вызова команды в Unix-формате. 1.556 - Предпочтительнее использовать этот формат чем hour:min:sec, 1.557 - использовавшийся в Labmaker 1.558 - 1.559 - fullprompt 1.560 - Приглашение командной строки 1.561 - 1.562 - prompt 1.563 - Сокращённое приглашение командной строки 1.564 + $cline_vt->process($cl{"raw_cline"}."\n"); 1.565 + $cl{"cline"} = $cline_vt->row_plaintext (1); 1.566 + $cl{"cline"} =~ s/\s*$//; 1.567 + $cline_vt->reset(); 1.568 1.569 - cline 1.570 - Командная строка 1.571 - 1.572 - output 1.573 - Результат выполнения команды 1.574 - 1.575 - diff 1.576 - Указатель на ассоциированный с командой diff 1.577 - 1.578 - note (!) 1.579 - Текстовый комментарий к команде. 1.580 - Может генерироваться из самого лога с помощью команд 1.581 - #^ Комментарий 1.582 - #= Комментарий 1.583 - #v Комментарий 1.584 - в том случае, если для комментирования достаточно одной строки, 1.585 - или с помощью команд 1.586 - cat > /dev/null #^ Заголовок 1.587 - Текст 1.588 - ^D 1.589 - в том случае, если комментарий развёрнутый. 1.590 - В последнем случае комментарий может содержать 1.591 - заголовок, абзацы и несложное форматирование. 1.592 + my %commands = extract_commands_from_cline($cl{"cline"}); 1.593 + $cl{"euid"}=0 if defined $commands{"sudo"}; 1.594 + my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands; 1.595 + $cl{"last_command"} = $comms[$#comms] || ""; 1.596 1.597 - Символы ^, v или = после знака комментария # обозначает, 1.598 - к какой команде относится комментарий: 1.599 - к предыдущей (^), последующей (v) 1.600 - или это общий комментарий по тексту, не относящийся непосредственно 1.601 - ни к одной из них (=) 1.602 + if ( 1.603 + $Config{"suppress_editors"} =~ /^y/i 1.604 + && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}}) 1.605 + || $Config{"suppress_pagers"} =~ /^y/i 1.606 + && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}}) 1.607 + || $Config{"suppress_terminal"}=~ /^y/i 1.608 + && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}}) 1.609 + ) { 1.610 + $cl{"suppress_output"} = "1"; 1.611 + } 1.612 + else { 1.613 + $cl{"suppress_output"} = "0"; 1.614 + } 1.615 + $skip_info = 0; 1.616 1.617 - err 1.618 - Код завершения командной строки 1.619 - 1.620 - histnum (!) 1.621 - Номер команды в истории командного интерпретатора 1.622 - 1.623 - status (!) 1.624 - Является ли данная команда вызванной (r), запомненной (s) 1.625 - или это подсказка completion (c). 1.626 - 1.627 - Команды, которые были вызваны и обработаны интерпретатором 1.628 - имеют состояние "r". К таким командам относится большинство 1.629 - команд вводимых в интерпретатор. 1.630 1.631 - Если команда набрана, но вызывать её по какой-либо причине 1.632 - не хочется (например, команда может быть не полной, вредоносной 1.633 - или просто бессмысленной в текущих условиях), 1.634 - её можно сбросить с помощью комбинации клавиш Ctrl-C 1.635 - (не путайте с прерыванием работающей команды! здесь она даже 1.636 - не запускается!). 1.637 - В таком случае она не выполняется, но попадает в журнал 1.638 - со статусом "s". 1.639 - 1.640 - Если команда появилась в журнале благодаря автопроолжению 1.641 - -- когда было показано несколько вариантов -- 1.642 - она имеет статус "c". 1.643 - 1.644 - euid 1.645 - Идентификатор пользователя от имени которого будет 1.646 - выполняться команда. 1.647 - Может отличаться от реального uid в том случае, 1.648 - если вызывается с помощью sudo 1.649 + print " ",$cl{"last_command"}; 1.650 1.651 - 1.652 - version (!) 1.653 - Версия lilalo-prompt использовавшаяся при записи 1.654 - команды. 1.655 + # Processing previous command line 1.656 + if ($first_pass) { 1.657 + $first_pass = 0; 1.658 + next; 1.659 + } 1.660 1.661 - 0 - версия использовавшая в labmaker. 1.662 - Отсутствует информация о текущем каталоге и номере в истории. 1.663 - Информация о версии также не указана в приглашении. 1.664 - 1.665 - 1.666 - 1 - версия использующаяся в lilalo 1.667 - 1.668 - raw_file 1.669 - Имя файла, в котором находится бинарное представление журнала. 1.670 - Может содержать ключевое слово HERE, 1.671 - обозначающее что бинарное представление хранится 1.672 - непосредственно в базе данных в атрибуте raw_data 1.673 + # Error code 1.674 + $last_cl{"raw_end"} = $cl{"raw_start"}; 1.675 + $last_cl{"err"}=$err; 1.676 + $last_cl{"err"}=130 if $err eq "^C"; 1.677 1.678 - raw_start 1.679 - Начало блока командной строки в файле бинарного представления 1.680 - 1.681 - raw_output_start 1.682 - Начало блока вывода 1.683 - 1.684 - raw_end 1.685 - Конец блока командной строки в файле бинарного представления 1.686 + if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) { 1.687 + bind_diff(\%last_cl); 1.688 + } 1.689 1.690 - raw_cline 1.691 - Необработанная командная строка (без приглашения) в бинарном виде 1.692 - 1.693 - raw_data (*) 1.694 - Бинарное представление команды и результатов её выполнения 1.695 + # Output 1.696 + if (!$last_cl{"suppress_output"} || $last_cl{"err"}) { 1.697 + for (my $i=0; $i<$Config{"terminal_height"}; $i++) { 1.698 + my $line= $vt->row_plaintext($i); 1.699 + next if !defined ($line) ; #|| $line =~ /^\s*$/; 1.700 + $line =~ s/\s*$//; 1.701 + $line .= "\n" unless $line =~ /^\s*$/; 1.702 + $last_cl{"output"} .= $line; 1.703 + } 1.704 + } 1.705 + else { 1.706 + $last_cl{"output"}= ""; 1.707 + } 1.708 1.709 + $vt->reset(); 1.710 1.711 1.712 - 1.713 -ТАБЛИЦА SESSION 1.714 - 1.715 - Информация о сеансах 1.716 + # Classifying the command line 1.717 1.718 - (см. lm-install) 1.719 1.720 + # Save 1.721 + if (!$Config{"lab"} || $cl{"lab"} eq $Config{"lab"}) { 1.722 + # Changing encoding 1.723 + for (keys %last_cl) { 1.724 + next if /raw/; 1.725 + $last_cl{$_} = $converter->convert($last_cl{$_}) 1.726 + if ($Config{"encoding"} && 1.727 + $Config{"encoding"} !~ /^utf-8$/i); 1.728 + } 1.729 + push @Command_Lines, \%last_cl; 1.730 1.731 -=cut 1.732 + # Сохранение позиции в файле, до которой выполнен 1.733 + # успешный разбор 1.734 + $Script_Files{$file}->{tell} = $last_cl{raw_end}; 1.735 + } 1.736 + next; 1.737 + } 1.738 + $last_output_length+=length($_); 1.739 + #if (!$cl{"suppress_output"} || $last_output_length < 5000) { 1.740 + if ($last_output_length < 50000) { 1.741 + $vt->process("$_"."\n") 1.742 + } 1.743 + else 1.744 + { 1.745 + if (!$skip_info) { 1.746 + print "($cl{last_command})"; 1.747 + $skip_info = 1; 1.748 + } 1.749 + } 1.750 + } 1.751 + close(FILE); 1.752 1.753 - $cl{"local_session_id"} = $local_session_id; 1.754 - # Parse new command 1.755 - $cl{"uid"} = $3; 1.756 - $cl{"euid"} = $cl{"uid"}; # Если в команде обнаружится sudo, euid поменяем на 0 1.757 - $cl{"pid"} = $4; 1.758 - $cl{"day"} = $5; 1.759 - $cl{"lab"} = $6; 1.760 - $cl{"hour"} = $7; 1.761 - $cl{"min"} = $8; 1.762 - $cl{"sec"} = $9; 1.763 - $cl{"fullprompt"} = $10; 1.764 - $cl{"prompt"} = $11; 1.765 - $cl{"raw_cline"} = $12; 1.766 - 1.767 - { 1.768 - use bytes; 1.769 - $cl{"raw_start"} = tell (FILE) - length($1); 1.770 - $cl{"raw_output_start"} = tell FILE; 1.771 - } 1.772 - $cl{"raw_file"} = $file; 1.773 - 1.774 - $cl{"err"} = 0; 1.775 - $cl{"output"} = ""; 1.776 - $cl{"tty"} = $tty; 1.777 - 1.778 - $cline_vt->process($cl{"raw_cline"}."\n"); 1.779 - $cl{"cline"} = $cline_vt->row_plaintext (1); 1.780 - $cl{"cline"} =~ s/\s*$//; 1.781 - $cline_vt->reset(); 1.782 - 1.783 - my %commands = extract_from_cline("commands", $cl{"cline"}); 1.784 - $cl{"euid"}=0 if defined $commands{"sudo"}; 1.785 - my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands; 1.786 - $cl{"last_command"} = $comms[$#comms] || ""; 1.787 - 1.788 - if ( 1.789 - $Config{"suppress_editors"} =~ /^y/i 1.790 - && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}}) || 1.791 - $Config{"suppress_pagers"} =~ /^y/i 1.792 - && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}}) || 1.793 - $Config{"suppress_terminal"}=~ /^y/i 1.794 - && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}}) 1.795 - ) { 1.796 - $cl{"suppress_output"} = "1"; 1.797 - } 1.798 - else { 1.799 - $cl{"suppress_output"} = "0"; 1.800 - 1.801 - } 1.802 - $skip_info = 0; 1.803 - 1.804 - 1.805 - print " ",$cl{"last_command"}; 1.806 - 1.807 - # Processing previous command line 1.808 - if ($first_pass) { 1.809 - $first_pass = 0; 1.810 - next; 1.811 - } 1.812 - 1.813 - # Error code 1.814 - $last_cl{"raw_end"} = $cl{"raw_start"}; 1.815 - $last_cl{"err"}=$err; 1.816 - $last_cl{"err"}=130 if $err eq "^C"; 1.817 - 1.818 - if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) { 1.819 - bind_diff(\%last_cl); 1.820 - } 1.821 - 1.822 - # Output 1.823 - if (!$last_cl{"suppress_output"} || $last_cl{"err"}) { 1.824 - for (my $i=0; $i<$Config{"terminal_height"}; $i++) { 1.825 - my $line= $vt->row_plaintext($i); 1.826 - next if !defined ($line) ; #|| $line =~ /^\s*$/; 1.827 - $line =~ s/\s*$//; 1.828 - $line .= "\n" unless $line =~ /^\s*$/; 1.829 - $last_cl{"output"} .= $line; 1.830 - } 1.831 - } 1.832 - else { 1.833 - $last_cl{"output"}= ""; 1.834 - } 1.835 - 1.836 - $vt->reset(); 1.837 - 1.838 - 1.839 - # Classifying the command line 1.840 - 1.841 - 1.842 - # Save 1.843 - if (!$Config{"lab"} || $cl{"lab"} eq $Config{"lab"}) { 1.844 - # Changing encoding 1.845 - for (keys %last_cl) { 1.846 - next if /raw/; 1.847 - $last_cl{$_} = $converter->convert($last_cl{$_}) 1.848 - if ($Config{"encoding"} && 1.849 - $Config{"encoding"} !~ /^utf-8$/i); 1.850 - } 1.851 - push @Command_Lines, \%last_cl; 1.852 - 1.853 - # Сохранение позиции в файле, до которой выполнен 1.854 - # успешный разбор 1.855 - $Script_Files{$file}->{tell} = $last_cl{raw_end}; 1.856 - } 1.857 - next; 1.858 - } 1.859 - $last_output_length+=length($_); 1.860 - #if (!$cl{"suppress_output"} || $last_output_length < 5000) { 1.861 - if ($last_output_length < 50000) { 1.862 - #print "(",length($_),")" if (length($_) > 2000) ; 1.863 - $vt->process("$_"."\n") 1.864 - } 1.865 - else 1.866 - { 1.867 - if (!$skip_info) { 1.868 - print "($cl{last_command})"; 1.869 - $skip_info = 1; 1.870 - } 1.871 - } 1.872 - } 1.873 - close(FILE); 1.874 - 1.875 - } 1.876 - if ($Config{"verbose"} =~ /y/) { 1.877 - print "...finished." ; 1.878 - print "Lines loaded: $commandlines_processed\n"; 1.879 - print "Command lines: $commandlines_loaded\n"; 1.880 - } 1.881 + } 1.882 + if ($Config{"verbose"} =~ /y/) { 1.883 + print "...finished." ; 1.884 + print "Lines loaded: $commandlines_processed\n"; 1.885 + print "Command lines: $commandlines_loaded\n"; 1.886 + } 1.887 } 1.888 1.889 1.890 1.891 + 1.892 +sub sort_command_lines 1.893 +{ 1.894 + print "Sorting command lines...\n" if $Config{"verbose"} =~ /y/; 1.895 + 1.896 + # Sort Command_Lines 1.897 + # Write Command_Lines to Command_Lines_Index 1.898 + 1.899 + my @index; 1.900 + for (my $i=0;$i<=$#Command_Lines;$i++) { 1.901 + $index[$i]=$i; 1.902 + } 1.903 + 1.904 + @Command_Lines_Index = sort { 1.905 + $Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"} || 1.906 + $Command_Lines[$index[$a]]->{"hour"} <=> $Command_Lines[$index[$b]]->{"hour"} || 1.907 + $Command_Lines[$index[$a]]->{"min"} <=> $Command_Lines[$index[$b]]->{"min"} || 1.908 + $Command_Lines[$index[$a]]->{"sec"} <=> $Command_Lines[$index[$b]]->{"sec"} 1.909 + } @index; 1.910 + 1.911 + print "...finished\n" if $Config{"verbose"} =~ /y/; 1.912 + 1.913 +} 1.914 + 1.915 sub printq 1.916 { 1.917 - my $TO = shift; 1.918 - my $text = join "", @_; 1.919 - $text =~ s/&/&/g; 1.920 - $text =~ s/</</g; 1.921 - $text =~ s/>/>/g; 1.922 - print $TO $text; 1.923 -} 1.924 - 1.925 - 1.926 -sub sort_command_lines 1.927 -{ 1.928 - print "Sorting command lines...\n" if $Config{"verbose"} =~ /y/; 1.929 - 1.930 - # Sort Command_Lines 1.931 - # Write Command_Lines to Command_Lines_Index 1.932 - 1.933 - my @index; 1.934 - for (my $i=0;$i<=$#Command_Lines;$i++) { 1.935 - $index[$i]=$i; 1.936 - } 1.937 - 1.938 - @Command_Lines_Index = sort { 1.939 - $Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"} || 1.940 - $Command_Lines[$index[$a]]->{"hour"} <=> $Command_Lines[$index[$b]]->{"hour"} || 1.941 - $Command_Lines[$index[$a]]->{"min"} <=> $Command_Lines[$index[$b]]->{"min"} || 1.942 - $Command_Lines[$index[$a]]->{"sec"} <=> $Command_Lines[$index[$b]]->{"sec"} 1.943 - } @index; 1.944 - 1.945 - print "...finished\n" if $Config{"verbose"} =~ /y/; 1.946 - 1.947 -} 1.948 - 1.949 -sub process_command_lines 1.950 -{ 1.951 - for my $i (@Command_Lines_Index) { 1.952 - 1.953 - my $cl = \$Command_Lines[$i]; 1.954 - @{${$cl}->{"new_commands"}} =(); 1.955 - @{${$cl}->{"new_files"}} =(); 1.956 - $$cl->{"class"} = ""; 1.957 - 1.958 - if ($$cl->{"err"}) { 1.959 - $$cl->{"class"}="wrong"; 1.960 - $$cl->{"class"}="interrupted" 1.961 - if ($$cl->{"err"} eq 130); 1.962 - } 1.963 - if (!$$cl->{"euid"}) { 1.964 - $$cl->{"class"}.="_root"; 1.965 - } 1.966 - 1.967 -#tab# my @tab_words=split /\s+/, $$cl->{"output"}; 1.968 -#tab# my $last_word= $$cl->{"cline"} =~ /(\S*)$/; 1.969 -#tab# $last_word =~ s@.*/@@; 1.970 -#tab# my $this_is_tab=1; 1.971 -#tab# 1.972 -#tab# if ($last_word && @tab_words >2) { 1.973 -#tab# for my $tab_words (@tab_words) { 1.974 -#tab# if ($tab_words !~ /^$last_word/) { 1.975 -#tab# $this_is_tab=0; 1.976 -#tab# last; 1.977 -#tab# } 1.978 -#tab# } 1.979 -#tab# } 1.980 -#tab# $$cl->{"class"}="tab" if $this_is_tab; 1.981 - 1.982 - 1.983 - if ( !$$cl->{"err"}) { 1.984 - # Command does not contain mistakes 1.985 - 1.986 - my %commands = extract_from_cline("commands", ${$cl}->{"cline"}); 1.987 - my %files = extract_from_cline("files", ${$cl}->{"cline"}); 1.988 - 1.989 - # Searching for new commands only 1.990 - for my $command (keys %commands) { 1.991 - if (!defined $Commands_Stat{$command}) { 1.992 - push @{$$cl->{new_commands}}, $command; 1.993 - } 1.994 - $Commands_Stat{$command}++; 1.995 - } 1.996 - 1.997 - for my $file (keys %files) { 1.998 - if (!defined $Files_Stat{$file}) { 1.999 - push @{$$cl->{new_files}}, $file; 1.1000 - } 1.1001 - $Files_Stat{$file}++; 1.1002 - } 1.1003 - } 1.1004 - 1.1005 - #if ($$cl->{cline}=~ /#\^(.*)/) { 1.1006 - # my $j=$i-1; 1.1007 - # $j-- while ($j >=0 && $Command_Lines[$j]->{tty} ne $$cl->{tty}); 1.1008 - # $Command_Lines[$j]->{note_title}="Замечание"; 1.1009 - # $Command_Lines[$j]->{note}="$1"; 1.1010 - #} 1.1011 - } 1.1012 - 1.1013 + my $TO = shift; 1.1014 + my $text = join "", @_; 1.1015 + $text =~ s/&/&/g; 1.1016 + $text =~ s/</</g; 1.1017 + $text =~ s/>/>/g; 1.1018 + print $TO $text; 1.1019 } 1.1020 1.1021 1.1022 @@ -712,218 +455,190 @@ 1.1023 Вывести результат обработки журнала. 1.1024 =cut 1.1025 1.1026 - 1.1027 sub print_command_lines 1.1028 { 1.1029 - my $output_filename=$_[0]; 1.1030 - my $mode = ">"; 1.1031 - $mode =">>" if $Config{mode} eq "daemon"; 1.1032 - open(OUT, $mode, $output_filename) 1.1033 - or die "Can't open $output_filename for writing\n"; 1.1034 + my $output_filename=$_[0]; 1.1035 + my $mode = ">"; 1.1036 + $mode =">>" if $Config{mode} eq "daemon"; 1.1037 + open(OUT, $mode, $output_filename) 1.1038 + or die "Can't open $output_filename for writing\n"; 1.1039 1.1040 1.1041 + my $cl; 1.1042 + my $in_range=0; 1.1043 + for my $i (@Command_Lines_Index) { 1.1044 + $cl = $Command_Lines[$i]; 1.1045 1.1046 - #print OUT "<livelablog>\n"; 1.1047 + if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) { 1.1048 + $in_range=1; 1.1049 + next; 1.1050 + } 1.1051 + if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) { 1.1052 + $in_range=0; 1.1053 + next; 1.1054 + } 1.1055 + next if ($Config{"from"} && $Config{"to"} && !$in_range) 1.1056 + || 1.1057 + ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ ) 1.1058 + || 1.1059 + ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0) 1.1060 + || 1.1061 + ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130); 1.1062 + 1.1063 + # Вырезаем из вывода только нужное количество строк 1.1064 1.1065 - my $cl; 1.1066 - my $in_range=0; 1.1067 - for my $i (@Command_Lines_Index) { 1.1068 - $cl = $Command_Lines[$i]; 1.1069 + my $output=""; 1.1070 + if ($Config{"head_lines"} || $Config{"tail_lines"}) { 1.1071 + # Partialy output 1.1072 + my @lines = split '\n', $cl->{"output"}; 1.1073 + # head 1.1074 + my $mark=1; 1.1075 + for (my $i=0; $i<= $#lines && $i < $Config{"cache_head_lines"}; $i++) { 1.1076 + $output .= $lines[$i]."\n"; 1.1077 + } 1.1078 + # tail 1.1079 + my $start=$#lines-$Config{"cache_tail_lines"}+1; 1.1080 + if ($start < 0) { 1.1081 + $start=0; 1.1082 + $mark=0; 1.1083 + } 1.1084 + if ($start < $Config{"cache_head_lines"}) { 1.1085 + $start=$Config{"cache_head_lines"}; 1.1086 + $mark=0; 1.1087 + } 1.1088 + $output .= $Config{"skip_text"}."\n" if $mark; 1.1089 + for (my $i=$start; $i<= $#lines; $i++) { 1.1090 + $output .= $lines[$i]."\n"; 1.1091 + } 1.1092 + } 1.1093 + else { 1.1094 + # Full output 1.1095 + $output .= $cl->{"output"}; 1.1096 + } 1.1097 1.1098 - if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) { 1.1099 - $in_range=1; 1.1100 - next; 1.1101 - } 1.1102 - if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) { 1.1103 - $in_range=0; 1.1104 - next; 1.1105 - } 1.1106 - next if ($Config{"from"} && $Config{"to"} && !$in_range) 1.1107 - || 1.1108 - ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ ) 1.1109 - || 1.1110 - ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0) 1.1111 - || 1.1112 - ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130); 1.1113 - 1.1114 - my @new_commands=@{$cl->{"new_commands"}}; 1.1115 - my @new_files=@{$cl->{"new_files"}}; 1.1116 + # Совместимость с labmaker 1.1117 1.1118 - my $cl_class="cline"; 1.1119 - my $out_class="output"; 1.1120 - if ($cl->{"class"}) { 1.1121 - $cl_class = $cl->{"class"}."_".$cl_class; 1.1122 - $out_class = $cl->{"class"}."_".$out_class; 1.1123 - } 1.1124 + # Переводим в секунды Эпохи 1.1125 + # В labmaker'е данные хранились в неудобной форме: hour, min, sec, day of year 1.1126 + # Информация о годе отсутствовала 1.1127 + # Её можно внести: 1.1128 + # Декабрь 2004 год; остальные -- 2005 год. 1.1129 1.1130 - # Вырезаем из вывода только нужное количество строк 1.1131 + my $year = 2005; 1.1132 + #$year = 2004 if ( $cl->{day} > 330 ); 1.1133 + $year = $Config{year} if $Config{year}; 1.1134 + # timelocal( $sec, $min, $hour, $mday,$mon,$year); 1.1135 + $cl->{time} = timelocal_nocheck($cl->{sec},$cl->{min},$cl->{hour},$cl->{day},0,$year); 1.1136 1.1137 - my $output=""; 1.1138 - if ($Config{"head_lines"} || $Config{"tail_lines"}) { 1.1139 - # Partialy output 1.1140 - my @lines = split '\n', $cl->{"output"}; 1.1141 - # head 1.1142 - my $mark=1; 1.1143 - for (my $i=0; $i<= $#lines && $i < $Config{"cache_head_lines"}; $i++) { 1.1144 - $output .= $lines[$i]."\n"; 1.1145 - } 1.1146 - # tail 1.1147 - my $start=$#lines-$Config{"cache_tail_lines"}+1; 1.1148 - if ($start < 0) { 1.1149 - $start=0; 1.1150 - $mark=0; 1.1151 - } 1.1152 - if ($start < $Config{"cache_head_lines"}) { 1.1153 - $start=$Config{"cache_head_lines"}; 1.1154 - $mark=0; 1.1155 - } 1.1156 - $output .= $Config{"skip_text"}."\n" if $mark; 1.1157 - for (my $i=$start; $i<= $#lines; $i++) { 1.1158 - $output .= $lines[$i]."\n"; 1.1159 - } 1.1160 - } 1.1161 - else { 1.1162 - # Full output 1.1163 - $output .= $cl->{"output"}; 1.1164 - } 1.1165 - #$output .= "^C\n" if ($cl->{"err"} eq "130"); 1.1166 1.1167 + # Начинаем вывод команды 1.1168 + print OUT "<command>\n"; 1.1169 + for my $element (qw( 1.1170 + local_session_id 1.1171 + time 1.1172 + raw_start 1.1173 + raw_output_start 1.1174 + raw_end 1.1175 + raw_file 1.1176 + tty 1.1177 + uid 1.1178 + err 1.1179 + last_command 1.1180 + )) { 1.1181 + next unless $cl->{"$element"}; 1.1182 + print OUT "<$element>".$cl->{$element}."</$element>\n"; 1.1183 + } 1.1184 + for my $element (qw( 1.1185 + prompt 1.1186 + cline 1.1187 + note 1.1188 + note_title 1.1189 + )) { 1.1190 + next unless $cl->{"$element"}; 1.1191 + print OUT "<$element>"; 1.1192 + printq(\*OUT,$cl->{"$element"}); 1.1193 + print OUT "</$element>\n"; 1.1194 + } 1.1195 + print OUT "<output>"; 1.1196 + printq(\*OUT,$output); 1.1197 + print OUT "</output>\n"; 1.1198 + if ($cl->{"diff"}) { 1.1199 + print OUT "<diff>"; 1.1200 + printq(\*OUT,${$Diffs{$cl->{"diff"}}}{"text"}); 1.1201 + print OUT "</diff>\n"; 1.1202 + } 1.1203 + print OUT "</command>\n"; 1.1204 1.1205 - # Совместимость с labmaker 1.1206 + } 1.1207 1.1208 - # Переводим в секунды Эпохи 1.1209 - # В labmaker'е данные хранились в неудобной форме: hour, min, sec, day of year 1.1210 - # Информация о годе отсутствовала 1.1211 - # Её можно внести: 1.1212 - # Декабрь 2004 год; остальные -- 2005 год. 1.1213 - 1.1214 - my $year = 2005; 1.1215 - #$year = 2004 if ( $cl->{day} > 330 ); 1.1216 - $year = $Config{year} if $Config{year}; 1.1217 - # timelocal( $sec, $min, $hour, $mday,$mon,$year); 1.1218 - $cl->{time} = timelocal_nocheck($cl->{sec},$cl->{min},$cl->{hour},$cl->{day},0,$year); 1.1219 - 1.1220 - 1.1221 - # Начинаем вывод команды 1.1222 - print OUT "<command>\n"; 1.1223 - print OUT "<local_session_id>",$cl->{local_session_id},"</local_session_id>\n"; 1.1224 - print OUT "<time>",$cl->{time},"</time>\n"; 1.1225 - print OUT "<raw_start>",$cl->{raw_start},"</raw_start>\n"; 1.1226 - print OUT "<raw_output_start>",$cl->{raw_output_start},"</raw_output_start>\n"; 1.1227 - print OUT "<raw_end>",$cl->{raw_end},"</raw_end>\n"; 1.1228 - print OUT "<raw_file>",$cl->{raw_file},"</raw_file>\n"; 1.1229 - print OUT "<tty>",$cl->{tty},"</tty>\n"; 1.1230 - print OUT "<uid>",$cl->{uid},"</uid>\n"; 1.1231 - print OUT "<out_class>",$out_class,"</out_class>\n"; 1.1232 - print OUT "<err>",$cl->{err},"</err>\n"; 1.1233 - print OUT "<prompt>"; 1.1234 - printq(\*OUT,,$cl->{"prompt"}); 1.1235 - print OUT "</prompt>"; 1.1236 - print OUT "<cline>"; 1.1237 - printq(\*OUT,$cl->{"cline"}); 1.1238 - print OUT "</cline>\n"; 1.1239 - print OUT "<last_command>",$cl->{"last_command"},"</last_command>\n"; 1.1240 - if (@new_commands) { 1.1241 - print OUT "<new_commands>"; 1.1242 - printq(\*OUT, join (" ", @new_commands)); 1.1243 - print OUT "</new_commands>"; 1.1244 - } 1.1245 - if (@new_files) { 1.1246 - print OUT "<new_files>"; 1.1247 - printq(\*OUT, join (" ", @new_files)); 1.1248 - print OUT "</new_files>"; 1.1249 - } 1.1250 - print OUT "<output>"; 1.1251 - printq(\*OUT,$output); 1.1252 - print OUT "</output>\n"; 1.1253 - if ($cl->{"diff"}) { 1.1254 - print OUT "<diff>"; 1.1255 - printq(\*OUT,${$Diffs{$cl->{"diff"}}}{"text"}); 1.1256 - print OUT "</diff>\n"; 1.1257 - } 1.1258 - if ($cl->{"note"}) { 1.1259 - print OUT "<note>"; 1.1260 - printq(\*OUT,$cl->{"note"}); 1.1261 - print OUT "</note>\n"; 1.1262 - } 1.1263 - if ($cl->{"note_title"}) { 1.1264 - print OUT "<note_title>"; 1.1265 - printq(\*OUT,$cl->{"note_title"}); 1.1266 - print OUT "</note_title>\n"; 1.1267 - } 1.1268 - print OUT "</command>\n"; 1.1269 - 1.1270 - } 1.1271 - 1.1272 - #print OUT "</livelablog>\n"; 1.1273 - close(OUT); 1.1274 + close(OUT); 1.1275 } 1.1276 1.1277 sub print_session 1.1278 { 1.1279 - my $output_filename = $_[0]; 1.1280 - my $local_session_id = $_[1]; 1.1281 - return if not defined($Sessions{$local_session_id}); 1.1282 + my $output_filename = $_[0]; 1.1283 + my $local_session_id = $_[1]; 1.1284 + return if not defined($Sessions{$local_session_id}); 1.1285 1.1286 - open(OUT, ">>", $output_filename) 1.1287 - or die "Can't open $output_filename for writing\n"; 1.1288 - print OUT "<session>\n"; 1.1289 - my %session = %{$Sessions{$local_session_id}}; 1.1290 - for my $key (keys %session) { 1.1291 - print OUT "<$key>".$session{$key}."</$key>\n" 1.1292 - } 1.1293 - print OUT "</session>\n"; 1.1294 - close(OUT); 1.1295 + open(OUT, ">>", $output_filename) 1.1296 + or die "Can't open $output_filename for writing\n"; 1.1297 + print OUT "<session>\n"; 1.1298 + my %session = %{$Sessions{$local_session_id}}; 1.1299 + for my $key (keys %session) { 1.1300 + print OUT "<$key>".$session{$key}."</$key>\n" 1.1301 + } 1.1302 + print OUT "</session>\n"; 1.1303 + close(OUT); 1.1304 } 1.1305 1.1306 sub send_cache 1.1307 { 1.1308 - # Если в кэше что-то накопилось, 1.1309 - # попытаемся отправить это на сервер 1.1310 - # 1.1311 - my $cache_was_sent=0; 1.1312 - 1.1313 - if (open(CACHE, $Config{cache})) { 1.1314 - local $/; 1.1315 - my $cache = <CACHE>; 1.1316 - close(CACHE); 1.1317 + # Если в кэше что-то накопилось, 1.1318 + # попытаемся отправить это на сервер 1.1319 + # 1.1320 + my $cache_was_sent=0; 1.1321 + 1.1322 + if (open(CACHE, $Config{cache})) { 1.1323 + local $/; 1.1324 + my $cache = <CACHE>; 1.1325 + close(CACHE); 1.1326 1.1327 - my $socket = IO::Socket::INET->new( 1.1328 - PeerAddr => $Config{backend_address}, 1.1329 - PeerPort => $Config{backend_port}, 1.1330 - proto => "tcp", 1.1331 - Type => SOCK_STREAM 1.1332 - ); 1.1333 + my $socket = IO::Socket::INET->new( 1.1334 + PeerAddr => $Config{backend_address}, 1.1335 + PeerPort => $Config{backend_port}, 1.1336 + proto => "tcp", 1.1337 + Type => SOCK_STREAM 1.1338 + ); 1.1339 1.1340 - if ($socket) { 1.1341 - print $socket $cache; 1.1342 - close($socket); 1.1343 - $cache_was_sent = 1; 1.1344 - } 1.1345 - } 1.1346 - return $cache_was_sent; 1.1347 + if ($socket) { 1.1348 + print $socket $cache; 1.1349 + close($socket); 1.1350 + $cache_was_sent = 1; 1.1351 + } 1.1352 + } 1.1353 + return $cache_was_sent; 1.1354 } 1.1355 1.1356 sub save_cache_stat 1.1357 { 1.1358 - open (CACHE, ">$Config{cache_stat}"); 1.1359 - for my $f (keys %Script_Files) { 1.1360 - print CACHE "$f\t",$Script_Files{$f}->{size},"\t",$Script_Files{$f}->{tell},"\n"; 1.1361 - } 1.1362 - close(CACHE); 1.1363 + open (CACHE, ">$Config{cache_stat}"); 1.1364 + for my $f (keys %Script_Files) { 1.1365 + print CACHE "$f\t",$Script_Files{$f}->{size},"\t",$Script_Files{$f}->{tell},"\n"; 1.1366 + } 1.1367 + close(CACHE); 1.1368 } 1.1369 1.1370 sub load_cache_stat 1.1371 { 1.1372 - if (open (CACHE, "$Config{cache_stat}")) { 1.1373 - while(<CACHE>) { 1.1374 - chomp; 1.1375 - my ($f, $size, $tell) = split /\t/; 1.1376 - $Script_Files{$f}->{size} = $size; 1.1377 - $Script_Files{$f}->{tell} = $tell; 1.1378 - } 1.1379 - close(CACHE); 1.1380 - }; 1.1381 + if (open (CACHE, "$Config{cache_stat}")) { 1.1382 + while(<CACHE>) { 1.1383 + chomp; 1.1384 + my ($f, $size, $tell) = split /\t/; 1.1385 + $Script_Files{$f}->{size} = $size; 1.1386 + $Script_Files{$f}->{tell} = $tell; 1.1387 + } 1.1388 + close(CACHE); 1.1389 + }; 1.1390 } 1.1391 1.1392 1.1393 @@ -931,102 +646,102 @@ 1.1394 1.1395 sub process_was_killed 1.1396 { 1.1397 - $Killed = 1; 1.1398 + $Killed = 1; 1.1399 } 1.1400 1.1401 sub main 1.1402 { 1.1403 1.1404 - $| = 1; 1.1405 + $| = 1; 1.1406 1.1407 - init_variables(); 1.1408 - init_config(); 1.1409 + init_variables(); 1.1410 + init_config(); 1.1411 1.1412 1.1413 - if ($Config{"mode"} ne "daemon") { 1.1414 + if ($Config{"mode"} ne "daemon") { 1.1415 1.1416 =cut 1.1417 - В нормальном режиме работы нужно 1.1418 - считать скрипты, обработать их и записать 1.1419 - результат выполнения в результриующий файл. 1.1420 - После этого завершить работу. 1.1421 + В нормальном режиме работы нужно 1.1422 + считать скрипты, обработать их и записать 1.1423 + результат выполнения в результирующий файл. 1.1424 + После этого завершить работу. 1.1425 =cut 1.1426 - for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) { 1.1427 - load_diff_files($lab_log); 1.1428 - } 1.1429 - load_command_lines($Config{"input"}, $Config{"input_mask"}); 1.1430 - sort_command_lines; 1.1431 - process_command_lines; 1.1432 - print_command_lines($Config{"cache"}); 1.1433 - } 1.1434 - else { 1.1435 - if (open(PIDFILE, $Config{agent_pidfile})) { 1.1436 - my $pid = <PIDFILE>; 1.1437 - close(PIDFILE); 1.1438 - if ($^O eq 'linux' && $pid &&(! -e "/proc/$pid" || !`grep $Config{"l3-agent"} /proc/$pid/cmdline && grep "uid:.*\b$<\b" /proc/$pid/status`)) { 1.1439 - print "Removing stale pidfile\n"; 1.1440 - unlink $Config{agent_pidfile} 1.1441 - or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!"; 1.1442 - } 1.1443 - elsif ($^O eq 'freebsd' && $pid && `ps axo uid,pid,command | grep '$<\\s*$pid\\s*$Config{"l3-agent"}' 2> /dev/null`) { 1.1444 - print "Removing stale pidfile\n"; 1.1445 - unlink $Config{agent_pidfile} 1.1446 - or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!"; 1.1447 - } 1.1448 - elsif ($^O eq 'linux' || $^O eq 'freebsd' ) { 1.1449 - print "l3-agent is already running: pid=$pid; pidfile=$Config{agent_pidfile}\n"; 1.1450 - exit(0); 1.1451 - } 1.1452 - else { 1.1453 - print "Unknown operating system"; 1.1454 - exit(0); 1.1455 - } 1.1456 - } 1.1457 - if ($Config{detach} =~ /^y/i) { 1.1458 - #$Config{verbose} = "no"; 1.1459 - my $pid = fork; 1.1460 - exit if $pid; 1.1461 - die "Couldn't fork: $!" unless defined ($pid); 1.1462 + for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) { 1.1463 + load_diff_files($lab_log); 1.1464 + } 1.1465 + load_command_lines($Config{"input"}, $Config{"input_mask"}); 1.1466 + sort_command_lines; 1.1467 + #process_command_lines; 1.1468 + print_command_lines($Config{"cache"}); 1.1469 + } 1.1470 + else { 1.1471 + if (open(PIDFILE, $Config{agent_pidfile})) { 1.1472 + my $pid = <PIDFILE>; 1.1473 + close(PIDFILE); 1.1474 + if ($^O eq 'linux' && $pid &&(! -e "/proc/$pid" || !`grep $Config{"l3-agent"} /proc/$pid/cmdline && grep "uid:.*\b$<\b" /proc/$pid/status`)) { 1.1475 + print "Removing stale pidfile\n"; 1.1476 + unlink $Config{agent_pidfile} 1.1477 + or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!"; 1.1478 + } 1.1479 + elsif ($^O eq 'freebsd' && $pid && `ps axo uid,pid,command | grep '$<\\s*$pid\\s*$Config{"l3-agent"}' 2> /dev/null`) { 1.1480 + print "Removing stale pidfile\n"; 1.1481 + unlink $Config{agent_pidfile} 1.1482 + or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!"; 1.1483 + } 1.1484 + elsif ($^O eq 'linux' || $^O eq 'freebsd' ) { 1.1485 + print "l3-agent is already running: pid=$pid; pidfile=$Config{agent_pidfile}\n"; 1.1486 + exit(0); 1.1487 + } 1.1488 + else { 1.1489 + print "Unknown operating system"; 1.1490 + exit(0); 1.1491 + } 1.1492 + } 1.1493 + if ($Config{detach} =~ /^y/i) { 1.1494 + #$Config{verbose} = "no"; 1.1495 + my $pid = fork; 1.1496 + exit if $pid; 1.1497 + die "Couldn't fork: $!" unless defined ($pid); 1.1498 1.1499 - open(PIDFILE, ">", $Config{agent_pidfile}) 1.1500 - or die "Can't open pidfile ". $Config{agent_pidfile}. " for wrting: $!"; 1.1501 - print PIDFILE $$; 1.1502 - close(PIDFILE); 1.1503 + open(PIDFILE, ">", $Config{agent_pidfile}) 1.1504 + or die "Can't open pidfile ". $Config{agent_pidfile}. " for wrting: $!"; 1.1505 + print PIDFILE $$; 1.1506 + close(PIDFILE); 1.1507 1.1508 - for my $handle (*STDIN, *STDOUT, *STDERR) { 1.1509 - open ($handle, "+<", "/dev/null") 1.1510 - or die "can't reopen $handle to /dev/null: $!" 1.1511 - } 1.1512 + for my $handle (*STDIN, *STDOUT, *STDERR) { 1.1513 + open ($handle, "+<", "/dev/null") 1.1514 + or die "can't reopen $handle to /dev/null: $!" 1.1515 + } 1.1516 1.1517 - POSIX::setsid() 1.1518 - or die "Can't start a new session: $!"; 1.1519 + POSIX::setsid() 1.1520 + or die "Can't start a new session: $!"; 1.1521 1.1522 - $0 = $Config{"l3-agent"}; 1.1523 - 1.1524 - $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&process_was_killed; 1.1525 - } 1.1526 - while (not $Killed) { 1.1527 - @Command_Lines = (); 1.1528 - @Command_Lines_Index = (); 1.1529 - for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) { 1.1530 - load_diff_files($lab_log); 1.1531 - } 1.1532 - load_cache_stat(); 1.1533 - load_command_lines($Config{"input"}, $Config{"input_mask"}); 1.1534 - if (@Command_Lines) { 1.1535 - sort_command_lines; 1.1536 - process_command_lines; 1.1537 - print_command_lines($Config{"cache"}); 1.1538 - } 1.1539 - save_cache_stat(); 1.1540 - if (-e $Config{cache} && (stat($Config{cache}))[7]) { 1.1541 - send_cache() && unlink($Config{cache}); 1.1542 - } 1.1543 - sleep($Config{"daemon_sleep_interval"} || 1); 1.1544 - } 1.1545 - 1.1546 - unlink $Config{agent_pidfile}; 1.1547 - } 1.1548 + $0 = $Config{"l3-agent"}; 1.1549 + 1.1550 + $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&process_was_killed; 1.1551 + } 1.1552 + while (not $Killed) { 1.1553 + @Command_Lines = (); 1.1554 + @Command_Lines_Index = (); 1.1555 + for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) { 1.1556 + load_diff_files($lab_log); 1.1557 + } 1.1558 + load_cache_stat(); 1.1559 + load_command_lines($Config{"input"}, $Config{"input_mask"}); 1.1560 + if (@Command_Lines) { 1.1561 + sort_command_lines; 1.1562 + process_command_lines; 1.1563 + print_command_lines($Config{"cache"}); 1.1564 + } 1.1565 + save_cache_stat(); 1.1566 + if (-e $Config{cache} && (stat($Config{cache}))[7]) { 1.1567 + send_cache() && unlink($Config{cache}); 1.1568 + } 1.1569 + sleep($Config{"daemon_sleep_interval"} || 1); 1.1570 + } 1.1571 + 1.1572 + unlink $Config{agent_pidfile}; 1.1573 + } 1.1574 1.1575 } 1.1576