rev |
line source |
devi@52
|
1 #!/usr/bin/perl -w
|
devi@23
|
2
|
devi@23
|
3 #
|
devi@62
|
4 # (c) Igor Chubin, igor@chub.in, 2004-2006
|
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@62
|
27 our %Script_Files; # Информация о позициях в скрипт-файлах,
|
devi@62
|
28 # до которых уже выполнен разбор
|
devi@62
|
29 # и информация о времени модификации файла
|
devi@62
|
30 # $Script_Files{$file}->{size}
|
devi@62
|
31 # $Script_Files{$file}->{tell}
|
devi@23
|
32
|
devi@62
|
33 our $Killed =0; # В режиме демона -- процесс получил сигнал о завершении
|
devi@23
|
34
|
devi@23
|
35 sub init_variables;
|
devi@23
|
36 sub main;
|
devi@23
|
37
|
devi@23
|
38 sub load_diff_files;
|
devi@23
|
39 sub bind_diff;
|
devi@62
|
40 sub extract_commands_from_cline;
|
devi@23
|
41 sub load_command_lines;
|
devi@23
|
42 sub sort_command_lines;
|
devi@23
|
43 sub print_command_lines;
|
devi@23
|
44 sub printq;
|
devi@23
|
45
|
devi@25
|
46 sub save_cache_stat;
|
devi@25
|
47 sub load_cache_stat;
|
devi@27
|
48 sub print_session;
|
devi@25
|
49
|
devi@23
|
50 sub load_diff_files
|
devi@23
|
51 {
|
devi@62
|
52 my @pathes = @_;
|
devi@62
|
53
|
devi@62
|
54 for my $path (@pathes) {
|
devi@62
|
55 my $template = "*.diff";
|
devi@62
|
56 my @files = <$path/$template>;
|
devi@62
|
57 my $i=0;
|
devi@62
|
58 for my $file (@files) {
|
devi@28
|
59
|
devi@62
|
60 next if defined($Diffs{$file});
|
devi@62
|
61 my %diff;
|
devi@23
|
62
|
devi@80
|
63 # Старый формат имени diff-файла
|
devi@80
|
64 # DEPRECATED
|
devi@80
|
65 if ($file=~m@/(D?[0-9][0-9]?[0-9]?)[^/]*?([0-9]*):([0-9]*):?([0-9]*)@) {
|
devi@80
|
66 $diff{"day"}=$1 || "";
|
devi@80
|
67 $diff{"hour"}=$2;
|
devi@80
|
68 $diff{"min"}=$3;
|
devi@80
|
69 $diff{"sec"}=$4 || 0;
|
devi@80
|
70
|
devi@80
|
71 $diff{"uid"} = 0 if $path =~ m@/root/@;
|
devi@23
|
72
|
devi@62
|
73 print "diff loaded: $diff{day} $diff{hour}:$diff{min}:$diff{sec}\n";
|
devi@80
|
74
|
devi@80
|
75 }
|
devi@80
|
76 # Новый формат имени diff-файла
|
devi@80
|
77 elsif ($file =~ m@.*/([^_]*)_([0-9]+)(.*)@) {
|
devi@80
|
78 $diff{"local_session_id"} = $1;
|
devi@80
|
79 $diff{"time"} = $2;
|
devi@80
|
80 $diff{"filename"} = $3;
|
devi@80
|
81 $diff{"filename"} =~ s@_@/@g;
|
devi@80
|
82 $diff{"filename"} =~ s@//@_@g;
|
devi@80
|
83
|
devi@80
|
84 print "diff loaded: $diff{filename} (time=$diff{time},session=$diff{local_session_id})\n";
|
devi@80
|
85 }
|
devi@80
|
86 else {
|
devi@80
|
87 next;
|
devi@80
|
88 }
|
devi@80
|
89
|
devi@80
|
90 # Чтение и изменение кодировки содержимого diff-файла
|
devi@62
|
91 local $/;
|
devi@62
|
92 open (F, "$file")
|
devi@62
|
93 or return "Can't open file $file ($_[0]) for reading";
|
devi@62
|
94 my $text = <F>;
|
devi@62
|
95 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i) {
|
devi@62
|
96 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8");
|
devi@62
|
97 $text = $converter->convert($text);
|
devi@62
|
98 }
|
devi@62
|
99 close(F);
|
devi@62
|
100 $diff{"text"}=$text;
|
devi@23
|
101
|
devi@80
|
102 $diff{"path"}=$path;
|
devi@80
|
103 $diff{"bind_to"}="";
|
devi@80
|
104 $diff{"time_range"}=-1;
|
devi@80
|
105 $diff{"index"}=$i;
|
devi@80
|
106
|
devi@62
|
107 $Diffs{$file} = \%diff;
|
devi@62
|
108 $i++;
|
devi@62
|
109 }
|
devi@62
|
110 }
|
devi@23
|
111 }
|
devi@23
|
112
|
devi@23
|
113
|
devi@23
|
114 sub bind_diff
|
devi@23
|
115 {
|
devi@62
|
116 print "Trying to bind diff...\n";
|
devi@23
|
117
|
devi@62
|
118 my $cl = shift;
|
devi@62
|
119 my $hour = $cl->{"hour"};
|
devi@62
|
120 my $min = $cl->{"min"};
|
devi@62
|
121 my $sec = $cl->{"sec"};
|
devi@23
|
122
|
devi@62
|
123 my $min_dt = 10000;
|
devi@23
|
124
|
devi@62
|
125 for my $diff_key (keys %Diffs) {
|
devi@62
|
126 my $diff = $Diffs{$diff_key};
|
devi@80
|
127 next if ($diff->{"local_session_id"}
|
devi@80
|
128 && $cl->{"local_session_id"}
|
devi@80
|
129 && ($cl->{"local_session_id"} ne $diff->{"local_session_id"}));
|
devi@80
|
130
|
devi@62
|
131 next if ($diff->{"day"} && $cl->{"day"} && ($cl->{"day"} ne $diff->{"day"}));
|
devi@80
|
132
|
devi@80
|
133 my $dt;
|
devi@80
|
134 if ($diff->{"time"} && $cl->{"time"}) {
|
devi@80
|
135 $dt = $diff->{"time"} - $cl->{"time"}
|
devi@80
|
136 }
|
devi@80
|
137 else {
|
devi@80
|
138 $dt=($diff->{"hour"}-$hour)*3600 +($diff->{"min"}-$min)*60 + ($diff->{"sec"}-$sec);
|
devi@80
|
139 }
|
devi@80
|
140 if ($dt >0
|
devi@80
|
141 && $dt < $min_dt
|
devi@80
|
142 && ($diff->{"time_range"} <0
|
devi@80
|
143 || $dt < $diff->{"time_range"})) {
|
devi@62
|
144 print "Approppriate diff found: dt=$dt\n";
|
devi@62
|
145 if ($diff->{"bind_to"}) {
|
devi@62
|
146 undef $diff->{"bind_to"}->{"diff"};
|
devi@62
|
147 };
|
devi@62
|
148 $diff->{"time_range"}=$dt;
|
devi@62
|
149 $diff->{"bind_to"}=$cl;
|
devi@23
|
150
|
devi@62
|
151 $cl->{"diff"} = $diff_key;
|
devi@62
|
152 $min_dt = $dt;
|
devi@80
|
153 }
|
devi@62
|
154 }
|
devi@23
|
155 }
|
devi@23
|
156
|
devi@23
|
157
|
devi@62
|
158 sub extract_commands_from_cline
|
devi@23
|
159 # Разобрать командную строку $_[1] и возвратить хэш, содержащий
|
devi@23
|
160 # номер первого появление команды в строке:
|
devi@62
|
161 # команда => первая позиция
|
devi@23
|
162 {
|
devi@62
|
163 my $cline = $_[0];
|
devi@62
|
164 my @lists = split /\;/, $cline;
|
devi@62
|
165
|
devi@62
|
166
|
devi@62
|
167 my @commands = ();
|
devi@62
|
168 for my $list (@lists) {
|
devi@62
|
169 push @commands, split /\|/, $list;
|
devi@62
|
170 }
|
devi@23
|
171
|
devi@62
|
172 my %commands;
|
devi@62
|
173 my %files;
|
devi@62
|
174 my $i=0;
|
devi@62
|
175 for my $command (@commands) {
|
devi@62
|
176 $command =~ /\s*(\S+)\s*(.*)/;
|
devi@62
|
177 if ($1 && $1 eq "sudo" ) {
|
devi@62
|
178 $commands{"$1"}=$i++;
|
devi@62
|
179 $command =~ s/\s*sudo\s+//;
|
devi@62
|
180 }
|
devi@62
|
181 $command =~ /\s*(\S+)\s*(.*)/;
|
devi@62
|
182 if ($1 && !defined $commands{"$1"}) {
|
devi@62
|
183 $commands{"$1"}=$i++;
|
devi@62
|
184 };
|
devi@62
|
185 }
|
devi@62
|
186 return %commands;
|
devi@23
|
187 }
|
devi@23
|
188
|
devi@23
|
189 sub load_command_lines
|
devi@23
|
190 {
|
devi@62
|
191 my $lab_scripts_path = $_[0];
|
devi@62
|
192 my $lab_scripts_mask = $_[1];
|
devi@23
|
193
|
devi@62
|
194 my $cline_re_base = qq'
|
devi@62
|
195 (
|
devi@62
|
196 (?:\\^?([0-9]*C?)) # exitcode
|
devi@62
|
197 (?:_([0-9]+)_)? # uid
|
devi@62
|
198 (?:_([0-9]+)_) # pid
|
devi@62
|
199 (...?) # day
|
devi@62
|
200 (.?.?) # lab
|
devi@62
|
201 \\s # space separator
|
devi@62
|
202 ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) # time
|
devi@62
|
203 .\\[50D.\\[K # killing symbols
|
devi@62
|
204 (.*?([\$\#]\\s?)) # prompt
|
devi@62
|
205 (.*) # command line
|
devi@62
|
206 )
|
devi@62
|
207 ';
|
devi@62
|
208 my $cline_re = qr/$cline_re_base/sx;
|
devi@62
|
209 my $cline_re2 = qr/$cline_re_base$/sx;
|
devi@23
|
210
|
devi@74
|
211 my $cline_re_v2_base = qq'
|
devi@74
|
212 (
|
devi@74
|
213 v2[\#] # version
|
devi@74
|
214 ([0-9]+)[\#] # history line number
|
devi@74
|
215 ([0-9]+)[\#] # exitcode
|
devi@74
|
216 ([0-9]+)[\#] # uid
|
devi@74
|
217 ([0-9]+)[\#] # pid
|
devi@74
|
218 ([0-9]+)[\#] # time
|
devi@74
|
219 (.*?)[\#] # pwd
|
devi@74
|
220 .\\[1024D.\\[K # killing symbols
|
devi@74
|
221 (.*?([\$\#]\\s?)) # prompt
|
devi@74
|
222 (.*) # command line
|
devi@74
|
223 )
|
devi@74
|
224 ';
|
devi@74
|
225
|
devi@74
|
226 my $cline_re_v2 = qr/$cline_re_v2_base/sx;
|
devi@74
|
227 my $cline_re2_v2 = qr/$cline_re_v2_base$/sx;
|
devi@74
|
228
|
devi@62
|
229 my $vt = Term::VT102->new ( 'cols' => $Config{"terminal_width"},
|
devi@81
|
230 'rows' => $Config{"terminal_height"});
|
devi@81
|
231 my $cline_vt = Term::VT102->new (
|
devi@81
|
232 'cols' => $Config{"terminal_width"},
|
devi@81
|
233 'rows' => $Config{"terminal_height"});
|
devi@23
|
234
|
devi@62
|
235 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8")
|
devi@62
|
236 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i);
|
devi@62
|
237
|
devi@74
|
238 print "Parsing lab scripts...\n" if $Config{"verbose"} =~ /y/;
|
devi@23
|
239
|
devi@62
|
240 my $file;
|
devi@62
|
241 my $skip_info;
|
devi@23
|
242
|
devi@62
|
243 my $commandlines_loaded =0;
|
devi@62
|
244 my $commandlines_processed =0;
|
devi@23
|
245
|
devi@62
|
246 my @lab_scripts = <$lab_scripts_path/$lab_scripts_mask>;
|
devi@62
|
247 for $file (@lab_scripts){
|
devi@23
|
248
|
devi@62
|
249 # Пропускаем файл, если он не изменялся со времени нашего предудущего прохода
|
devi@62
|
250 my $size = (stat($file))[7];
|
devi@62
|
251 next if ($Script_Files{$file} && $Script_Files{$file}->{size} && $Script_Files{$file}->{size} >= $size);
|
devi@27
|
252
|
devi@27
|
253
|
devi@62
|
254 my $local_session_id;
|
devi@62
|
255 # Начальное значение идентификатора текущего сеанса определяем из имени скрипта
|
devi@62
|
256 # Впоследствии оно может быть уточнено
|
devi@62
|
257 $file =~ m@.*/([^/]*)\.script$@;
|
devi@62
|
258 $local_session_id = $1;
|
devi@27
|
259
|
devi@62
|
260 #Если файл только что появился,
|
devi@62
|
261 #пытаемся найти и загрузить информацию о соответствующей ему сессии
|
devi@62
|
262 if (!$Script_Files{$file}) {
|
devi@62
|
263 my $session_file = $file;
|
devi@62
|
264 $session_file =~ s/\.script/.info/;
|
devi@62
|
265 if (open(SESSION, $session_file)) {
|
devi@62
|
266 local $/;
|
devi@62
|
267 my $data = <SESSION>;
|
devi@62
|
268 close(SESSION);
|
devi@27
|
269
|
devi@62
|
270 for my $session_data ($data =~ m@<session>(.*?)</session>@sg) {
|
devi@62
|
271 my %session;
|
devi@62
|
272 while ($session_data =~ m@<([^>]*?)>(.*?)</\1>@sg) {
|
devi@62
|
273 $session{$1} = $2;
|
devi@62
|
274 }
|
devi@62
|
275 $local_session_id = $session{"local_session_id"} if $session{"local_session_id"};
|
devi@62
|
276 $Sessions{$local_session_id}=\%session;
|
devi@62
|
277 }
|
devi@25
|
278
|
devi@62
|
279 #Загруженную информацию сразу же отправляем в поток
|
devi@62
|
280 print_session($Config{cache}, $local_session_id);
|
devi@62
|
281 }
|
devi@84
|
282 else {
|
devi@84
|
283 die "can't open session file";
|
devi@84
|
284 }
|
devi@62
|
285 }
|
devi@25
|
286
|
devi@62
|
287 open (FILE, "$file");
|
devi@62
|
288 binmode FILE;
|
devi@23
|
289
|
devi@62
|
290 # Переходим к тому месту, где мы окончили разбор
|
devi@62
|
291 seek (FILE, $Script_Files{$file}->{tell}, 0) if $Script_Files{$file}->{tell};
|
devi@62
|
292 $Script_Files{$file}->{size} = $size;
|
devi@62
|
293 $Script_Files{$file}->{tell} = 0 unless $Script_Files{$file}->{tell};
|
devi@32
|
294
|
devi@62
|
295 $file =~ m@.*/(.*?)-.*@;
|
devi@23
|
296
|
devi@83
|
297 print "\n+- processing file $file\n| "
|
devi@83
|
298 if $Config{"verbose"} =~/y/;
|
devi@74
|
299
|
devi@62
|
300 my $tty = $1;
|
devi@62
|
301 my $first_pass = 1;
|
devi@62
|
302 my %cl;
|
devi@62
|
303 my $last_output_length=0;
|
devi@62
|
304 while (<FILE>) {
|
devi@62
|
305 $commandlines_processed++;
|
devi@23
|
306
|
devi@62
|
307 next if s/^Script started on.*?\n//s;
|
devi@23
|
308
|
devi@62
|
309 if (/[0-9][0-9]:[0-9][0-9]:[0-9][0-9].\[[0-9][0-9]D.\[K/ && m/$cline_re/) {
|
devi@62
|
310 s/.*\x0d(?!\x0a)//;
|
devi@62
|
311 m/$cline_re2/gs;
|
devi@23
|
312
|
devi@62
|
313 $commandlines_loaded++;
|
devi@62
|
314 $last_output_length=0;
|
devi@23
|
315
|
devi@62
|
316 # Previous command
|
devi@62
|
317 my %last_cl = %cl;
|
devi@62
|
318 my $err = $2 || "";
|
devi@23
|
319
|
devi@62
|
320 $cl{"local_session_id"} = $local_session_id;
|
devi@62
|
321 # Parse new command
|
devi@62
|
322 $cl{"uid"} = $3;
|
devi@74
|
323 #$cl{"euid"} = $cl{"uid"}; # Если в команде обнаружится sudo, euid поменяем на 0
|
devi@62
|
324 $cl{"pid"} = $4;
|
devi@62
|
325 $cl{"day"} = $5;
|
|