lilalo

annotate l3-agent @ 58:93e98a3fa44d

find changesets by author, revision, files, or words in the commit message
Наконец-то пофиксил неверное определение присутствия l3-agent в FreeBSD
author devi
date Sat Jan 14 00:12:41 2006 +0200 (2006-01-14)
parents 187b6636a3be
children c4bea959dbb1
rev   line source
devi@52 1 #!/usr/bin/perl -w
devi@23 2
devi@23 3 #
devi@23 4 # (c) Igor Chubin, imchubin@mail.ru, 2004-2005
devi@23 5 #
devi@23 6
devi@50 7
devi@50 8 ## Эта строчка добавлена из блокнота Windows
devi@50 9 ## Надо отдать должное, он каким-то образом научился понимать кодировку
devi@50 10
devi@23 11 use strict;
devi@25 12 use POSIX;
devi@23 13 use Term::VT102;
devi@23 14 use Text::Iconv;
devi@23 15 use Time::Local 'timelocal_nocheck';
devi@27 16 use IO::Socket;
devi@23 17
devi@32 18 use lib "/usr/local/bin";
devi@23 19 use l3config;
devi@23 20
devi@23 21
devi@23 22 our @Command_Lines;
devi@23 23 our @Command_Lines_Index;
devi@28 24 our %Diffs;
devi@27 25 our %Sessions;
devi@23 26
devi@23 27 our %Commands_Stat; # Statistics about commands usage
devi@23 28 our %Files_Stat; # Statistics about commands usage
devi@23 29
devi@25 30 our %Script_Files; # Информация о позициях в скрипт-файлах,
devi@25 31 # до которых уже выполнен разбор
devi@25 32 # и информация о времени модификации файла
devi@25 33 # $Script_Files{$file}->{size}
devi@25 34 # $Script_Files{$file}->{tell}
devi@25 35
devi@25 36 our $Killed =0; # В режиме демона -- процесс получил сигнал о завершении
devi@23 37
devi@23 38 sub init_variables;
devi@23 39 sub main;
devi@23 40
devi@23 41 sub load_diff_files;
devi@23 42 sub bind_diff;
devi@23 43 sub extract_from_cline;
devi@23 44 sub load_command_lines;
devi@23 45 sub sort_command_lines;
devi@23 46 sub process_command_lines;
devi@23 47 sub print_command_lines;
devi@23 48 sub printq;
devi@23 49
devi@25 50 sub save_cache_stat;
devi@25 51 sub load_cache_stat;
devi@27 52 sub print_session;
devi@25 53
devi@23 54 sub load_diff_files
devi@23 55 {
devi@23 56 my @pathes = @_;
devi@23 57
devi@23 58 for my $path (@pathes) {
devi@23 59 my $template = "*.diff";
devi@23 60 my @files = <$path/$template>;
devi@23 61 my $i=0;
devi@23 62 for my $file (@files) {
devi@28 63
devi@28 64 next if defined($Diffs{$file});
devi@28 65
devi@23 66 my %diff;
devi@23 67
devi@23 68 $diff{"path"}=$path;
devi@23 69 $diff{"uid"}="SET THIS";
devi@23 70
devi@23 71 # Сейчас UID определяется из названия каталога
devi@23 72 # откуда берутся diff-файлы
devi@23 73 # Это неправильно
devi@23 74 #
devi@23 75 # ВАРИАНТ:
devi@23 76 # К файлам жураналам должны прилагаться ситемны файлы,
devi@23 77 # мз которых и будет определяться соответствие
devi@23 78 # имён пользователей их uid'ам
devi@23 79 #
devi@23 80 $diff{"uid"} = 0 if $path =~ m@/root/@;
devi@23 81
devi@23 82 $diff{"bind_to"}="";
devi@23 83 $diff{"time_range"}=-1;
devi@23 84
devi@23 85 next if not $file=~m@/(D?[0-9][0-9]?[0-9]?)[^/]*?([0-9]*):([0-9]*):?([0-9]*)@;
devi@23 86 $diff{"day"}=$1 || "";
devi@23 87 $diff{"hour"}=$2;
devi@23 88 $diff{"min"}=$3;
devi@23 89 $diff{"sec"}=$4 || 0;
devi@23 90
devi@23 91 $diff{"index"}=$i;
devi@23 92
devi@23 93 print "diff loaded: $diff{day} $diff{hour}:$diff{min}:$diff{sec}\n";
devi@23 94
devi@23 95 local $/;
devi@23 96 open (F, "$file")
devi@23 97 or return "Can't open file $file ($_[0]) for reading";
devi@23 98 my $text = <F>;
devi@23 99 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i) {
devi@23 100 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8");
devi@23 101 $text = $converter->convert($text);
devi@23 102 }
devi@23 103 close(F);
devi@23 104 $diff{"text"}=$text;
devi@23 105 #print "$file loaded ($diff{day})\n";
devi@23 106
devi@28 107 #push @Diffs, \%diff;
devi@28 108 $Diffs{$file} = \%diff;
devi@23 109 $i++;
devi@23 110 }
devi@23 111 }
devi@23 112 }
devi@23 113
devi@23 114
devi@23 115 sub bind_diff
devi@23 116 {
devi@23 117 # my $path = shift;
devi@23 118 # my $pid = shift;
devi@23 119 # my $day = shift;
devi@23 120 # my $lab = shift;
devi@23 121
devi@23 122 print "Trying to bind diff...\n";
devi@23 123
devi@23 124 my $cl = shift;
devi@23 125 my $hour = $cl->{"hour"};
devi@23 126 my $min = $cl->{"min"};
devi@23 127 my $sec = $cl->{"sec"};
devi@23 128
devi@23 129 my $min_dt = 10000;
devi@23 130
devi@28 131 for my $diff_key (keys %Diffs) {
devi@28 132 my $diff = $Diffs{$diff_key};
devi@23 133 # Check here date, time and user
devi@23 134 next if ($diff->{"day"} && $cl->{"day"} && ($cl->{"day"} ne $diff->{"day"}));
devi@23 135 #next if (!$diff->{"uid"} && $cl->{"euid"} != $diff->{"uid"});
devi@23 136
devi@23 137 my $dt=($diff->{"hour"}-$hour)*3600 +($diff->{"min"}-$min)*60 + ($diff->{"sec"}-$sec);
devi@23 138 if ($dt >0 && $dt < $min_dt && ($diff->{"time_range"} <0 || $dt < $diff->{"time_range"})) {
devi@23 139 print "Approppriate diff found: dt=$dt\n";
devi@23 140 if ($diff->{"bind_to"}) {
devi@23 141 undef $diff->{"bind_to"}->{"diff"};
devi@23 142 };
devi@23 143 $diff->{"time_range"}=$dt;
devi@23 144 $diff->{"bind_to"}=$cl;
devi@23 145
devi@28 146 #$cl->{"diff"} = $diff->{"index"};
devi@28 147 $cl->{"diff"} = $diff_key;
devi@23 148 $min_dt = $dt;
devi@23 149 }
devi@23 150
devi@23 151 }
devi@23 152 }
devi@23 153
devi@23 154
devi@23 155 sub extract_from_cline
devi@23 156 # Разобрать командную строку $_[1] и возвратить хэш, содержащий
devi@23 157 # номер первого появление команды в строке:
devi@23 158 # команда => первая позиция
devi@23 159 {
devi@23 160 my $what = $_[0];
devi@23 161 my $cline = $_[1];
devi@23 162 my @lists = split /\;/, $cline;
devi@23 163
devi@23 164
devi@23 165 my @commands = ();
devi@23 166 for my $list (@lists) {
devi@23 167 push @commands, split /\|/, $list;
devi@23 168 }
devi@23 169
devi@23 170 my %commands;
devi@23 171 my %files;
devi@23 172 my $i=0;
devi@23 173 for my $command (@commands) {
devi@23 174 $command =~ /\s*(\S+)\s*(.*)/;
devi@23 175 if ($1 && $1 eq "sudo" ) {
devi@23 176 $commands{"$1"}=$i++;
devi@23 177 $command =~ s/\s*sudo\s+//;
devi@23 178 }
devi@23 179 $command =~ /\s*(\S+)\s*(.*)/;
devi@23 180 if ($1 && !defined $commands{"$1"}) {
devi@23 181 $commands{"$1"}=$i++;
devi@23 182 };
devi@23 183 if ($2) {
devi@23 184 my $args = $2;
devi@23 185 my @args = split (/\s+/, $args);
devi@23 186 for my $a (@args) {
devi@23 187 $files{"$a"}=$i++
devi@23 188 if !defined $files{"$a"};
devi@23 189 };
devi@23 190
devi@23 191
devi@23 192 }
devi@23 193 }
devi@23 194
devi@23 195 if ($what eq "commands") {
devi@23 196 return %commands;
devi@23 197 } else {
devi@23 198 return %files;
devi@23 199 }
devi@23 200
devi@23 201 }
devi@23 202
devi@23 203 sub load_command_lines
devi@23 204 {
devi@23 205 my $lab_scripts_path = $_[0];
devi@23 206 my $lab_scripts_mask = $_[1];
devi@23 207
devi@23 208 my $cline_re_base = qq'
devi@25 209 (
devi@25 210 (?:\\^?([0-9]*C?)) # exitcode
devi@23 211 (?:_([0-9]+)_)? # uid
devi@23 212 (?:_([0-9]+)_) # pid
devi@23 213 (...?) # day
devi@23 214 (.?.?) # lab
devi@23 215 \\s # space separator
devi@23 216 ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) # time
devi@23 217 .\\[50D.\\[K # killing symbols
devi@23 218 (.*?([\$\#]\\s?)) # prompt
devi@23 219 (.*) # command line
devi@25 220 )
devi@23 221 ';
devi@23 222 #my $cline_re = qr/$cline_re_base(?:$cline_re_base|$)/x;
devi@23 223 #my $cline_re = qr/(?:$cline_re_base)*$cline_re_base$/x;
devi@23 224 my $cline_re = qr/$cline_re_base/sx;
devi@23 225 my $cline_re1 = qr/$cline_re_base\x0D/sx;
devi@23 226 my $cline_re2 = qr/$cline_re_base$/sx;
devi@23 227
devi@23 228 my $vt = Term::VT102->new ( 'cols' => $Config{"terminal_width"},
devi@23 229 'rows' => $Config{"terminal_height"});
devi@23 230 my $cline_vt = Term::VT102->new ('cols' => $Config{"terminal_width"},
devi@23 231 'rows' => $Config{"terminal_height"});
devi@23 232
devi@23 233 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8")
devi@23 234 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i);
devi@23 235
devi@23 236 print "Loading lm-scripts...\n" if $Config{"verbose"} =~ /y/;
devi@23 237
devi@23 238 my $file;
devi@23 239 my $skip_info;
devi@23 240
devi@23 241 my $commandlines_loaded =0;
devi@23 242 my $commandlines_processed =0;
devi@23 243
devi@27 244 my @lab_scripts = <$lab_scripts_path/$lab_scripts_mask>;
devi@23 245 for $file (@lab_scripts){
devi@25 246
devi@25 247 # Пропускаем файл, если он не изменялся со времени нашего предудущего прохода
devi@25 248 my $size = (stat($file))[7];
devi@25 249 next if ($Script_Files{$file} && $Script_Files{$file}->{size} && $Script_Files{$file}->{size} >= $size);
devi@23 250
devi@27 251
devi@27 252 my $local_session_id;
devi@27 253 # Начальное значение идентификатора текущего сеанса определяем из имени скрипта
devi@27 254 # Впоследствии оно может быть уточнено
devi@30 255 $file =~ m@.*/([^/]*)\.script$@;
devi@27 256 $local_session_id = $1;
devi@27 257
devi@27 258 #Если файл только что появился,
devi@27 259 #пытаемся найти и загрузить информацию о соответствующей ему сессии
devi@27 260 if (!$Script_Files{$file}) {
devi@27 261 my $session_file = $file;
devi@27 262 $session_file =~ s/\.script/.info/;
devi@27 263 if (open(SESSION, $session_file)) {
devi@27 264 local $/;
devi@27 265 my $data = <SESSION>;
devi@27 266 close(SESSION);
devi@27 267
devi@27 268 for my $session_data ($data =~ m@<session>(.*?)</session>@sg) {
devi@27 269 my %session;
devi@27 270 while ($session_data =~ m@<([^>]*?)>(.*?)</\1>@sg) {
devi@27 271 $session{$1} = $2;
devi@27 272 }
devi@27 273 $local_session_id = $session{"local_session_id"} if $session{"local_session_id"};
devi@28 274 $Sessions{$local_session_id}=\%session;
devi@27 275 }
devi@27 276
devi@27 277 #Загруженную информацию сразу же отправляем в поток
devi@27 278 print_session($Config{cache}, $local_session_id);
devi@27 279 }
devi@27 280 }
devi@27 281
devi@23 282 open (FILE, "$file");
devi@23 283 binmode FILE;
devi@25 284
devi@25 285 # Переходим к тому месту, где мы окончили разбор
devi@25 286 seek (FILE, $Script_Files{$file}->{tell}, 0) if $Script_Files{$file}->{tell};
devi@25 287 $Script_Files{$file}->{size} = $size;
devi@25 288 $Script_Files{$file}->{tell} = 0 unless $Script_Files{$file}->{tell};
devi@25 289