lilalo

annotate l3-agent @ 150:822b36252d7f

find changesets by author, revision, files, or words in the commit message
Вывод больших фрагментов текста не теряется.

Большие фрагменты текста теперь не вырезаются бесследно.
Там, откуда они вырезаются, вставляются ссылки,
по которым можно посмотреть полную версию вывода.
Испытано на больших фрагментах текста,
содержащих до 5000 строк (фрагменты более 5000 строк по умолчанию
обрезаются административно; допустимые размеры задаются в l3config.pm).
Исправлены ошибки, из-за которых большие фрагменты
обрабатывались некорректно.
author igor@chub.in
date Tue Jun 23 01:15:02 2009 +0300 (2009-06-23)
parents 58c869722fd0
children 8ee5e59f1bd3
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 } </