lilalo: 822b36252d7f l3-agent

lilalo

view l3-agent @ 150:822b36252d7f

Вывод больших фрагментов текста не теряется.

Большие фрагменты текста теперь не вырезаются бесследно.
Там, откуда они вырезаются, вставляются ссылки,
по которым можно посмотреть полную версию вывода.
Испытано на больших фрагментах текста,
содержащих до 5000 строк (фрагменты более 5000 строк по умолчанию
обрезаются административно; допустимые размеры задаются в l3config.pm).
Исправлены ошибки, из-за которых большие фрагменты
обрабатывались некорректно.

author	igor@chub.in
date	Tue Jun 23 01:15:02 2009 +0300 (2009-06-23)
parents	58c869722fd0
children	8ee5e59f1bd3

line source

1 #!/usr/bin/perl -w

3 #

4 # (c) Igor Chubin, igor@chub.in, 2004-2008

5 #

7 use strict;

8 use POSIX;

9 use Term::VT102;

10 use Text::Iconv;

11 use Time::Local 'timelocal_nocheck';

12 use IO::Socket;

14 use lib "/etc/lilalo";

15 use l3config;

17 our @Command_Lines;

18 our @Command_Lines_Index;

19 our %Diffs;

20 our %Sessions;

22 our %Script_Files; # Информация о позициях в скрипт-файлах,

23 # до которых уже выполнен разбор

24 # и информация о времени модификации файла

25 # $Script_Files{$file}->{size}

26 # $Script_Files{$file}->{tell}

28 our $Killed =0; # В режиме демона -- процесс получил сигнал о завершении

30 sub init_variables;

31 sub main;

33 sub load_diff_files;

34 sub bind_diff;

35 sub extract_commands_from_cline;

36 sub load_command_lines;

37 sub sort_command_lines;

38 sub print_command_lines;

39 sub printq;

41 sub save_cache_stat;

42 sub load_cache_stat;

43 sub print_session;

45 sub load_diff_files

46 {

47 my @pathes = @_;

49 for my $path (@pathes) {

50 my $template = "*.diff";

51 my @files = <$path/$template>;

52 my $i=0;

53 for my $file (@files) {

55 next if defined($Diffs{$file});

56 my %diff;

58 # Старый формат имени diff-файла

59 # DEPRECATED

60 if ($file=~m@/(D?[0-9][0-9]?[0-9]?)[^/]*?([0-9]*):([0-9]*):?([0-9]*)@) {

61 $diff{"day"}=$1 || "";

62 $diff{"hour"}=$2;

63 $diff{"min"}=$3;

64 $diff{"sec"}=$4 || 0;

66 $diff{"uid"} = 0 if $path =~ m@/root/@;

68 print "diff loaded: $diff{day} $diff{hour}:$diff{min}:$diff{sec}\n";

70 }

71 # Новый формат имени diff-файла

72 elsif ($file =~ m@.*/([^_]*)_([0-9]+)(.*)@) {

73 $diff{"local_session_id"} = $1;

74 $diff{"time"} = $2;

75 $diff{"filename"} = $3;

76 $diff{"filename"} =~ s@_@/@g;

77 $diff{"filename"} =~ s@//@_@g;

79 print "diff loaded: $diff{filename} (time=$diff{time},session=$diff{local_session_id})\n";

80 }

81 else {

82 next;

83 }

85 # Чтение и изменение кодировки содержимого diff-файла

86 local $/;

87 open (F, "$file")

88 or return "Can't open file $file ($_[0]) for reading";

89 my $text = <F>;

90 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i) {

91 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8");

92 $text = $converter->convert($text);

93 }

94 close(F);

95 $diff{"text"}=$text;

97 $diff{"path"}=$path;

98 $diff{"bind_to"}="";

99 $diff{"time_range"}=-1;

100 $diff{"index"}=$i;

101

102 $Diffs{$file} = \%diff;

103 $i++;

104 }

105 }

106 }

107

108

109 sub bind_diff

110 {

111 print "Trying to bind diff...\n";

112

113 my $cl = shift;

114 my $hour = $cl->{"hour"};

115 my $min = $cl->{"min"};

116 my $sec = $cl->{"sec"};

117

118 my $min_dt = 10000;

119

120 if (defined($cl->{"diff"})) {

121 print STDERR "Command ".$cl->{time}." is already bound";

122 return;

123 }

124

125 # Загружаем новые diff-файлы

126 # Это нужно делать непосредственно перед привязкой, поскольку diff'ы могли образоваться только что

127 for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) {

128 load_diff_files($lab_log);

129 }

130

131 my $diff_to_bind;

132 for my $diff_key (keys %Diffs) {

133 my $diff = $Diffs{$diff_key};

134 next if ($diff->{"local_session_id"}

135 && $cl->{"local_session_id"}

136 && ($cl->{"local_session_id"} ne $diff->{"local_session_id"}));

137

138 next if ($diff->{"day"} && $cl->{"day"} && ($cl->{"day"} ne $diff->{"day"}));

139

140 my $dt;

141 if (not $diff->{"time"}) {

142 print STDERR "diff time is 0";

143 print STDERR join(" ", keys(%$diff));

144 print STDERR $diff->{text};

145 }

146 if (not $cl->{"time"}) {

147 print STDERR "cl time is 0";

148 }

149 if ($diff->{"time"} && $cl->{"time"}) {

150 $dt = $diff->{"time"} - $cl->{"time"}

151 }

152 else {

153 $dt=($diff->{"hour"}-$hour)*3600 +($diff->{"min"}-$min)*60 + ($diff->{"sec"}-$sec);

154 }

155 if ($dt >=0 && $dt < $min_dt && !$diff->{"bind_to"}) {

156 $min_dt = $dt;

157 $diff_to_bind = $diff_key;

158 }

159 }

160 if ($diff_to_bind) {

161 print "Approppriate diff found: dt=$min_dt\n";

162 $Diffs{$diff_to_bind}->{"bind_to"}=$cl;

163 $cl->{"diff"} = $diff_to_bind;

164 }

165 else {

166 print STDERR "Diff not found\n";

167 print STDERR "cl{time}",$cl->{time},"\n";

168 }

169 }

170

171

172 sub extract_commands_from_cline

173 # Разобрать командную строку $_[1] и возвратить хэш, содержащий

174 # номер первого появление команды в строке:

175 # команда => первая позиция

176 {

177 my $cline = $_[0];

178 my @lists = split /\;/, $cline;

179

180

181 my @commands = ();

182 for my $list (@lists) {

183 push @commands, split /\|/, $list;

184 }

185

186 my %commands;

187 my %files;

188 my $i=0;

189 for my $command (@commands) {

190 $command =~ /\s*(\S+)\s*(.*)/;

191 if ($1 && $1 eq "sudo" ) {

192 $commands{"$1"}=$i++;

193 $command =~ s/\s*sudo\s+//;

194 }

195 $command =~ /\s*(\S+)\s*(.*)/;

196 if ($1 && !defined $commands{"$1"}) {

197 $commands{"$1"}=$i++;

198 };

199 }

200 return %commands;

201 }

202

203 sub load_command_lines

204 {

205 my $lab_scripts_path = $_[0];

206 my $lab_scripts_mask = $_[1];

207

208 my $cline_re_base = qq'

209 (

210 (?:\\^?([0-9]*C?)) # exitcode

211 (?:_([0-9]+)_)? # uid

212 (?:_([0-9]+)_) # pid

213 (...?) # day

214 (.?.?) # lab

215 \\s # space separator

216 ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) # time

217 .\\[50D.\\[K # killing symbols

218 (.*?([\$\#]\\s?)) # prompt

219 (.*) # command line

220 )

221 ';

222 my $cline_re = qr/$cline_re_base/sx;

223 my $cline_re2 = qr/$cline_re_base$/sx;

224

225 my $cline_re_v2_base = qq'

226 (

227 v2[\#] # version

228 ([0-9]+)[\#] # history line number

229 ([0-9]+)[\#] # exitcode

230 ([0-9]+)[\#] # uid

231 ([0-9]+)[\#] # pid

232 ([0-9]+)[\#] # time

233 (.*?)[\#] # pwd

234 .\\[1024D.\\[K # killing symbols

235 (.*?([\$\#]\\s?)) # prompt

236 (.*) # command line

237 )

238 ';

239

240 my $cline_re_v2 = qr/$cline_re_v2_base/sx;

241 my $cline_re2_v2 = qr/$cline_re_v2_base$/sx;

242

243 my $cline_re_v3_base = qq'

244 (

245 v3[\#] # version

246 .*

247 )

248 ';

249 my $cline_re_v3 = qr/$cline_re_v3_base/sx;

250

251 my $cline_re2_v3_base = qq'

252 (

253 v3[\#] # version

254 ([0-9]+)[\#] # history line number

255 ([0-9]+)[\#] # exitcode

256 ([0-9]+)[\#] # uid

257 ([0-9]+)[\#] # pid

258 ([0-9]+)[\#] # time

259 (.*?)[\#] # pwd

260 (.*?)[\#] # nonce

261 (.*?([\$\#]\\s?)) # prompt

262 (.*) # command line

263 )

264 ';

265 my $cline_re2_v3 = qr/$cline_re2_v3_base$/sx;

266

267

268 my %vt; # Хэш виртуальных терминалов. По одному на каждый сеанс

269 my $cline_vt = Term::VT102->new (

270 'cols' => $Config{"terminal_width"},

271 'rows' => $Config{"terminal_height"});

272

273 my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8")

274 if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i);

275

276 print "Parsing lab scripts...\n" if $Config{"verbose"} =~ /y/;

277

278 my $file;

279 my $skip_info;

280

281 my $commandlines_loaded =0;

282 my $commandlines_processed =0;

283

284 my @lab_scripts = <$lab_scripts_path/$lab_scripts_mask>;

285 for $file (@lab_scripts){

286

287 # Пропускаем файл, если он не изменялся со времени нашего предудущего прохода

288 my $size = (stat($file))[7];

289 next if ($Script_Files{$file} && $Script_Files{$file}->{size} && $Script_Files{$file}->{size} >= $size);

290

291

292 my $local_session_id;

293 # Начальное значение идентификатора текущего сеанса определяем из имени скрипта

294 # Впоследствии оно может быть уточнено

295 $file =~ m@.*/([^/]*)\.script$@;

296 $local_session_id = $1;

297

298 if (not defined($vt{$local_session_id})) {

299 $vt{$local_session_id} = Term::VT102->new (

300 'cols' => $Config{"terminal_width"},

301 'rows' => $Config{"terminal_height"});

302 }

303

304 #Если файл только что появился,

305 #пытаемся найти и загрузить информацию о соответствующей ему сессии

306 if (!$Script_Files{$file}) {

307 my $session_file = $file;

308 $session_file =~ s/\.script/.info/;

309 if (open(SESSION, $session_file)) {

310 local $/;

311 my $data = <SESSION>;

312 close(SESSION);

313

314 for my $session_data ($data =~ m@<session>(.*?)</session>@sg) {

315 my %session;

316 while ($session_data =~ m@<([^>]*?)>(.*?)</\1>@sg) {

317 $session{$1} = $2;

318 }

319 $local_session_id = $session{"local_session_id"} if $session{"local_session_id"};

320 $Sessions{$local_session_id}=\%session;

321 }

322

323 #Загруженную информацию сразу же отправляем в поток

324 print_session($Config{cache}, $local_session_id);

325 }

326 else {

327 die "can't open session file";

328 }

329 }

330

331 open (FILE, "$file");

332 binmode FILE;

333

334 # Переходим к тому месту, где мы окончили разбор

335 seek (FILE, $Script_Files{$file}->{tell}, 0) if $Script_Files{$file}->{tell};

336 $Script_Files{$file}->{size} = $size;

337 $Script_Files{$file}->{tell} = 0 unless $Script_Files{$file}->{tell};

338

339 $file =~ m@.*/(.*?)-.*@;

340

341 print "\n+- processing file $file\n| "

342 if $Config{"verbose"} =~/y/;

343

344 my $tty = $1;

345 my %cl;

346 my $last_output_length=0;

347 my $saved_output;

348 while (<FILE>) {

349 $commandlines_processed++;

350

351 next if s/^Script started on.*?\n//s;

352

353 if (/[0-9][0-9]:[0-9][0-9]:[0-9][0-9].\[[0-9][0-9]D.\[K/ && m/$cline_re/) {

354 s/.*\x0d(?!\x0a)//;

355 m/$cline_re2/gs;

356

357 $commandlines_loaded++;

358 $last_output_length=0;

359

360 # Previous command

361 my %last_cl = %cl;

362 my $this_line = $1;

363 my $err = $2 || "";

364

365 $cl{"local_session_id"} = $local_session_id;

366 # Parse new command

367 $cl{"uid"} = $3;

368 #$cl{"euid"} = $cl{"uid"}; # Если в команде обнаружится sudo, euid поменяем на 0

369 $cl{"pid"} = $4;

370 $cl{"day"} = $5;

371 $cl{"lab"} = $6;

372 $cl{"hour"} = $7;

373 $cl{"min"} = $8;

374 $cl{"sec"} = $9;

375 #$cl{"fullprompt"} = $10;

376 $cl{"prompt"} = $11;

377 $cl{"raw_cline"} = $12;

378

379 {

380 use bytes;

381 $cl{"raw_start"} = tell (FILE) - length($this_line);

382 $cl{"raw_output_start"} = tell FILE;

383 }

384 $cl{"raw_file"} = $file;

385

386 $cl{"err"} = 0;

387 $cl{"output"} = "";

388 $cl{"tty"} = $tty;

389

390 $cline_vt->process($cl{"raw_cline"}."\n");

391 $cl{"cline"} = $cline_vt->row_plaintext (1);

392 $cl{"cline"} =~ s/\s*$//;

393 $cl{"cline"} =~ s/.*?[\#\$]\s*//;

394 $cline_vt->reset();

395

396 my %commands = extract_commands_from_cline($cl{"cline"});

397 #$cl{"euid"}=0 if defined $commands{"sudo"};

398 my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands;

399 $cl{"last_command"} = $comms[$#comms] || "";

400

401 if (

402 $Config{"suppress_editors"} =~ /^y/i

403 && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}})

404 || $Config{"suppress_pagers"} =~ /^y/i

405 && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}})

406 || $Config{"suppress_terminal"}=~ /^y/i

407 && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}})

408 ) {

409 $cl{"suppress_output"} = "1";

410 }

411 else {

412 $cl{"suppress_output"} = "0";

413 }

414 $skip_info = 0;

415

416

417 print " ",$cl{"last_command"};

418

419 if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) {

420 bind_diff(\%last_cl);

421 }

422

423 # Error code

424 $last_cl{"raw_end"} = $cl{"raw_start"};

425 $last_cl{"err"}=$err;

426 $last_cl{"err"}=130 if $err eq "^C";

427

428

429 # Output

430 if (!$last_cl{"suppress_output"} || $last_cl{"err"}) {

431 for (my $i=0; $i<$Config{"terminal_height"}; $i++) {

432 my $line= $vt{$local_session_id}->row_plaintext($i);

433 next if !defined ($line) ; #|| $line =~ /^\s*$/;

434 $line =~ s/\s*$//;

435 $line .= "\n" unless $line =~ /^\s*$/;

436 $last_cl{"output"} .= $line;

437 }

438 }

439 else {

440 $last_cl{"output"}= "";

441 }

442

443 $vt{$local_session_id}->reset();

444

445

446 # Save

447 if (!$Config{"lab"} || $cl{"lab"} eq $Config{"lab"}) {

448 # Changing encoding

449 for (keys %last_cl) {

450 next if /raw/;

451 $last_cl{$_} = $converter->convert($last_cl{$_})

452 if ($Config{"encoding"} &&

453 $Config{"encoding"} !~ /^utf-8$/i);

454 }

455 push @Command_Lines, \%last_cl;

456

457 # Сохранение позиции в файле, до которой выполнен

458 # успешный разбор

459 $Script_Files{$file}->{tell} = $last_cl{raw_end};

460 }

461 next;

462 }

463

464 elsif (m/$cline_re_v2/ || m/$cline_re_v3/) {

465 # Разбираем командную строку версии 2

466 my $before=$_;

467 s/.*\x0d(?!\x0a)//;

468

469 my $re;

470 if (m/$cline_re_v2/) {

471 $re=$cline_re2_v2;

472 }

473 else {

474 s/.\[1K.\[10D//gs;

475 $re=$cline_re2_v3;

476 print STDERR "... $_ ...\n";

477 }

478 m/$re/gs;

479

480 $commandlines_loaded++;

481 $last_output_length=0;

482

483 # Previous command

484 my %last_cl = %cl;

485

486 $cl{"local_session_id"} = $local_session_id;

487 # Parse new command

488 my $this_line = $1;

489 $cl{"history"} = $2;

490 my $err = $3;

491 $cl{"uid"} = $4;

492 #$cl{"euid"} = $cl{"uid"}; # Если в команде обнаружится sudo, euid поменяем на 0

493 $cl{"pid"} = $5;

494 $cl{"time"} = $6;

495 $cl{"pwd"} = $7;

496 $cl{"nonce"} = $8;

497 #$cl{"fullprompt"} = $8;

498 $cl{"prompt"} = $10;

499 #$cl{"raw_cline"}= $10;

500 $cl{"raw_cline"}= $before;

501

502 {

503 use bytes;

504 $cl{"raw_start"} = tell (FILE) - length($before);

505 $cl{"raw_output_start"} = tell FILE;

506 }

507 $cl{"raw_file"} = $file;

508

509 $cl{"err"} = 0;

510 $cl{"output"} = "";

511 #$cl{"tty"} = $tty;

512

513 $cline_vt->process($cl{"raw_cline"}."\n");

514 $cl{"cline"} = $cline_vt->row_plaintext (1);

515 $cl{"cline"} =~ s/\s*$//;

516 $cl{"cline"} =~ s/.*?[\#\$]\s*//;

517 $cline_vt->reset();

518 print STDERR "cline=".$cl{"cline"}."<<\n";

519

520 my %commands = extract_commands_from_cline($cl{"cline"});

521 #$cl{"euid"} = 0 if defined $commands{"sudo"};

522 my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands;

523 $cl{"last_command"}

524 = $comms[$#comms] || "";

525

526 print STDERR "last_command=".$cl{"last_command"}."<<\n";

527

528 if (

529 $Config{"suppress_editors"} =~ /^y/i

530 && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}})

531 || $Config{"suppress_pagers"} =~ /^y/i

532 && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}})

533 || $Config{"suppress_terminal"}=~ /^y/i

534 && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}})

535 ) {

536 $cl{"suppress_output"} = "1";

537 }

538 else {

539 $cl{"suppress_output"} = "0";

540 }

541 $skip_info = 0;

542

543 if ($Config{verbose} =~ /y/i) {

544 print "\n| " if $commandlines_loaded % 5 == 1;

545 print " ",$cl{"last_command"};

546 }

547

548 if (defined($last_cl{time})

549 && grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) {

550 bind_diff(\%last_cl);

551 }

552

553 # Error code

554 $last_cl{"err"}=$err;

555 $last_cl{"raw_end"} = $cl{"raw_start"};

556

557 # Output

558 if (!$last_cl{"suppress_output"} || $last_cl{"err"}) {

559 $last_cl{"output"}=$saved_output;

560 for (my $i=0; $i<$Config{"terminal_height"}; $i++) {

561 my $line= $vt{$local_session_id}->row_plaintext($i);

562 next if !defined ($line) ; #|| $line =~ /^\s*$/;

563 $line =~ s/\s*$//;

564 $line .= "\n" unless $line =~ /^\s*$/;

565 $last_cl{"output"} .= $line;

566 }

567 }

568 else {

569 $last_cl{"output"}= "";

570 }

571

572 $vt{$local_session_id}->reset();

573 $saved_output="";

574

575

576 # Changing encoding

577 for (keys %last_cl) {

578 next if /raw/;

579 if ($Config{"encoding"} &&

580 $Config{"encoding"} !~ /^utf-8$/i) {

581 $last_cl{$_} = $converter->convert($last_cl{$_})

582 }

583 }

584 if (defined($last_cl{time})) {

585 print STDERR "push id=".$last_cl{time}."\n";

586 push @Command_Lines, \%last_cl;

587 # Сохранение позиции в файле, до которой выполнен

588 # успешный разбор

589 $Script_Files{$file}->{tell} = $last_cl{raw_end};

590 }

591 next;

592 }

593

594 if (($commandlines_processed%100) == 0) {

595 # Каждые сто строк обнуляем терминал и переносим вывод из него в кэш

596 # Output

597 for (my $i=0; $i<$Config{"terminal_height"}; $i++) {

598 my $line= $vt{$local_session_id}->row_plaintext($i);

599 next if !defined ($line) ; #|| $line =~ /^\s*$/;

600 $line =~ s/\s*$//;

601 $line .= "\n" unless $line =~ /^\s*$/;

602 $saved_output .= $line;

603 }

604 $vt{$local_session_id}->reset();

605 $last_output_length=0;

606 }

607

608 # Иначе, это строка вывода

609

610 $last_output_length+=length($_);

611 #if (!$cl{"suppress_output"} || $last_output_length < 5000) {

612 if ($last_output_length < 50000) {

613 $vt{$local_session_id}->process("$_"."\n")

614 }

615 else

616 {

617 if (!$skip_info && defined($cl{last_command})) {

618 print "($cl{last_command})";

619 $skip_info = 1;

620 }

621 }

622 }

623 close(FILE);

624

625 }

626 if ($Config{"verbose"} =~ /y/) {

627 print "\n`- finished.\n" ;

628 print "Lines loaded: $commandlines_processed\n";

629 print "Command lines: $commandlines_loaded\n";

630 }

631 }

632

633

634

635

636 sub sort_command_lines

637 {

638 print "Sorting command lines..." if $Config{"verbose"} =~ /y/;

639

640 # Sort Command_Lines

641 # Write Command_Lines to Command_Lines_Index

642

643 my @index;

644 for (my $i=0;$i<=$#Command_Lines;$i++) {

645 $index[$i]=$i;

646 }

647

648 @Command_Lines_Index = sort {

649 defined($Command_Lines[$index[$a]]->{"time"})

650 && defined($Command_Lines[$index[$b]]->{"time"})

651 ? $Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"}

652 : defined($Command_Lines[$index[$a]]->{"day"})

653 && defined($Command_Lines[$index[$b]]->{"day"})

654 && defined($Command_Lines[$index[$a]]->{"hour"})

655 && defined($Command_Lines[$index[$b]]->{"hour"})

656 && defined($Command_Lines[$index[$a]]->{"min"})

657 && defined($Command_Lines[$index[$b]]->{"min"})

658 && defined($Command_Lines[$index[$a]]->{"sec"})

659 && defined($Command_Lines[$index[$b]]->{"sec"})

660 ? $Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"}

661 || $Command_Lines[$index[$a]]->{"hour"} <=> $Command_Lines[$index[$b]]->{"hour"}

662 || $Command_Lines[$index[$a]]->{"min"} <=> $Command_Lines[$index[$b]]->{"min"}

663 || $Command_Lines[$index[$a]]->{"sec"} <=> $Command_Lines[$index[$b]]->{"sec"}

664 : 0

665 } @index;

666

667 print "finished\n" if $Config{"verbose"} =~ /y/;

668

669 }

670

671 sub printq

672 {

673 my $TO = shift;

674 my $text = join "", @_;

675 $text =~ s/&/&/g;

676 $text =~ s/</</g;

677 $text =~ s/>/>/g;

678 print $TO $text;

679 }

680

681

682 =cut

683 Вывести результат обработки журнала.

684 =cut

685

686 sub print_command_lines

687 {

688 my $output_filename=$_[0];

689 open(OUT, ">>", $output_filename)

690 or die "Can't open $output_filename for writing\n";

691

692

693 my $cl;

694 my $in_range=0;

695 for my $i (@Command_Lines_Index) {

696 $cl = $Command_Lines[$i];

697

698 if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) {

699 $in_range=1;

700 next;

701 }

702 if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) {

703 $in_range=0;

704 next;

705 }

706 next if ($Config{"from"} && $Config{"to"} && !$in_range)

707 ||

708 ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ )

709 ||

710 ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0)

711 ||

712 ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130);

713

714 # Вырезаем из вывода только нужное количество строк

715

716 my $output="";

717

718 if (!grep ($_ eq $cl->{"last_command"}, @{$Config{"full_output_commands"}})

719 && ($Config{"head_lines"}

720 || $Config{"tail_lines"})) {

721 # Partialy output

722 my @lines = split '\n', $cl->{"output"};

723 # head

724 my $mark=1;

725 for (my $i=0; $i<= $#lines && $i < $Config{"cache_head_lines"}; $i++) {

726 $output .= $lines[$i]."\n";

727 }

728 # tail

729 my $start=$#lines-$Config{"cache_tail_lines"}+1;

730 if ($start < 0) {

731 $start=0;

732 $mark=0;

733 }

734 if ($start < $Config{"cache_head_lines"}) {

735 $start=$Config{"cache_head_lines"};

736 $mark=0;

737 }

738 $output .= $Config{"skip_text"}."\n" if $mark;

739 for ($i=$start; $i<= $#lines; $i++) {

740 $output .= $lines[$i]."\n";

741 }

742 }

743 else {

744 # Full output

745 $output .= $cl->{"output"};

746 }

747

748 # Совместимость с labmaker

749

750 # Переводим в секунды Эпохи

751 # В labmaker'е данные хранились в неудобной форме: hour, min, sec, day of year

752 # Информация о годе отсутствовала

753 # Её можно внести:

754 # Декабрь 2004 год; остальные -- 2005 год.

755

756 my $year = 2005;

757 #$year = 2004 if ( $cl->{day} > 330 );

758 $year = $Config{year} if $Config{year};

759 # timelocal( $sec, $min, $hour, $mday,$mon,$year);

760 $cl->{time} ||= timelocal_nocheck($cl->{sec},$cl->{min},$cl->{hour},$cl->{day},0,$year);

761

762

763 # Начинаем вывод команды

764 print OUT "<command>\n";

765 print OUT "<l3cd>$Config{l3cd}</l3cd>\n" if $Config{"l3cd"};

766 for my $element (qw(

767 local_session_id

768 history

769 uid

770 pid

771 time

772 pwd

773 raw_start

774 raw_output_start

775 raw_end

776 raw_file

777 tty

778 err

779 last_command

780 history

781 nonce

782 )) {

783 next unless defined($cl->{"$element"});

784 print OUT "<$element>".$cl->{$element}."</$element>\n";

785 }

786 for my $element (qw(

787 prompt

788 cline

789 )) {

790 next unless defined($cl->{"$element"});

791 print OUT "<$element>";

792 printq(\*OUT,$cl->{"$element"});

793 print OUT "</$element>\n";

794 }

795 #note

796 #note_title

797 print OUT "<output>";

798 printq(\*OUT,$output);

799 print OUT "</output>\n";

800 if ($cl->{"diff"}) {

801 print OUT "<diff>";

802 printq(\*OUT,${$Diffs{$cl->{"diff"}}}{"text"});

803 print OUT "</diff>\n";

804 }

805 print OUT "</command>\n";

806

807 }

808

809 close(OUT);

810 }

811

812 sub print_session

813 {

814 my $output_filename = $_[0];

815 my $local_session_id = $_[1];

816 return if not defined($Sessions{$local_session_id});

817

818 print "printing session info. session id = ".$local_session_id."\n"

819 if $Config{verbose} =~ /y/;

820

821 open(OUT, ">>", $output_filename)

822 or die "Can't open $output_filename for writing\n";

823 print OUT "<session>\n";

824 print OUT "<l3cd>$Config{l3cd}</l3cd>\n" if $Config{"l3cd"};

825 my %session = %{$Sessions{$local_session_id}};

826 for my $key (keys %session) {

827 print OUT "<$key>".$session{$key}."</$key>\n";

828 print " ".$key,"\n";

829 }

830 print OUT "</session>\n";

831 close(OUT);

832 }

833

834 sub send_cache

835 {

836 # Если в кэше что-то накопилось,

837 # попытаемся отправить это на сервер

838 #

839 my $cache_was_sent=0;

840

841 if (open(CACHE, $Config{cache})) {

842 local $/;

843 my $cache = <CACHE>;

844 close(CACHE);

845

846 my $socket = IO::Socket::INET->new(

847 PeerAddr => $Config{backend_address},

848 PeerPort => $Config{backend_port},

849 proto => "tcp",

850 Type => SOCK_STREAM

851 );

852

853 if ($socket) {

854 print $socket $cache;

855 close($socket);

856 $cache_was_sent = 1;

857 }

858 }

859 return $cache_was_sent;

860 }

861

862 sub save_cache_stat

863 {

864 open (CACHE, ">$Config{cache_stat}");

865 for my $f (keys %Script_Files) {

866 print CACHE "$f\t",$Script_Files{$f}->{size},"\t",$Script_Files{$f}->{tell},"\n";

867 }

868 close(CACHE);

869 }

870

871 sub load_cache_stat

872 {

873 if (open (CACHE, "$Config{cache_stat}")) {

874 while(<CACHE>) {

875 chomp;

876 my ($f, $size, $tell) = split /\t/;

877 $Script_Files{$f}->{size} = $size;

878 $Script_Files{$f}->{tell} = $tell;

879 }

880 close(CACHE);

881 };

882 }

883

884

885 main();

886

887 sub process_was_killed

888 {

889 $Killed = 1;

890 }

891

892 sub reload

893 {

894 init_config;

895 }

896

897 sub main

898 {

899

900 $| = 1;

901

902 init_variables();

903 init_config();

904

905

906 if ($Config{"mode"} ne "daemon") {

907

908 # В нормальном режиме работы нужно

909 # считать скрипты, обработать их и записать

910 # результат выполнения в результирующий файл.

911 # После этого завершить работу.

912

913 # Очистим кэш-файл, если он существовал

914 if (open (CACHE, ">", $Config{"cache"})) {

915 close(CACHE);

916 };

917 load_command_lines($Config{"input"}, $Config{"input_mask"});

918 sort_command_lines;

919 #process_command_lines;

920 print_command_lines($Config{"cache"});

921 }

922 else {

923 if (open(PIDFILE, $Config{agent_pidfile})) {

924 my $pid = <PIDFILE>;

925 close(PIDFILE);

926 if ($^O eq 'linux' && $pid &&(! -e "/proc/$pid" || !`grep $Config{"l3-agent"} /proc/$pid/cmdline && grep "uid:.*\b$<\b" /proc/$pid/status`)) {

927 print "Removing stale pidfile\n";

928 unlink $Config{agent_pidfile}

929 or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!";

930 }

931 elsif ($^O eq 'freebsd' && defined($pid) && $pid ne "" && not `ps axo uid,pid,command | grep '$< $pid $Config{"l3-agent"}' | grep -v grep 2> /dev/null`) {

932 print "Removing stale pidfile\n";

933 unlink $Config{agent_pidfile}

934 or die "Can't remove stale pidfile ". $Config{agent_pidfile}. " : $!";

935 }

936 elsif ($^O eq 'linux' || $^O eq 'freebsd' ) {

937 print "l3-agent is already running: pid=$pid; pidfile=$Config{agent_pidfile}\n";

938 exit(0);

939 }

940 else {

941 print "Unknown operating system";

942 exit(0);

943 }