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
|
devi@62
|
331 open (FILE, "$file");
|
|