lilalo
annotate l3-agent @ 119:71bd999bcb04
Исправлено несколько багов:
* выполняется корректная привязка diff'ов
* правильно запоминается raw_start и проч raw_*
* временно отключен вывод признака нажатия ctrl-c (он ставился неверно)
* в приглашение добавлен случайный nonce (для правильной отработки tab)
* выполняется корректная привязка diff'ов
* правильно запоминается raw_start и проч raw_*
* временно отключен вывод признака нажатия ctrl-c (он ставился неверно)
* в приглашение добавлен случайный nonce (для правильной отработки tab)
author | igor |
---|---|
date | Thu Mar 13 12:19:42 2008 +0200 (2008-03-13) |
parents | 9e6359b7ad55 |
children | 42d9af3c851c |
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 |