lilalo: f9d0d35618f8 l3-agent

lilalo

view l3-agent @ 139:f9d0d35618f8

Удалены файлы из labmaker

Удалены файлы, которые переползли в репозиторий
из проекта labmaker
Если кому-то нужны эти файлы,
они есть в старом CVS-репозитории lilalo.

Удаление лишних файлов ещё полностью
не завершено. Ещё будем удалять

author	igor@chub.in
date	Mon Jul 21 12:28:13 2008 +0300 (2008-07-21)
parents	42d9af3c851c
children	822b36252d7f

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 while (<FILE>) {

348 $commandlines_processed++;

349

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

351

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

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

354 m/$cline_re2/gs;

355

356 $commandlines_loaded++;

357 $last_output_length=0;

358

359 # Previous command

360 my %last_cl = %cl;

361 my $this_line = $1;

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

363

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

365 # Parse new command

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

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

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

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

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

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

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

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

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

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

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

377

378 {

379 use bytes;

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

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

382 }

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

384

385 $cl{"err"} = 0;

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

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

388

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

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

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

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

393 $cline_vt->reset();

394

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

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

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

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

399

400 if (

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

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

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

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

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

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

407 ) {

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

409 }

410 else {

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

412 }

413 $skip_info = 0;

414

415

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

417

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

419 bind_diff(\%last_cl);

420 }

421

422 # Error code

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

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

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

426

427

428 # Output

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

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

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

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

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

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

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

436 }

437 }

438 else {

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

440 }

441

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

443

444

445 # Save

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

447 # Changing encoding

448 for (keys %last_cl) {

449 next if /raw/;

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

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

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

453 }

454 push @Command_Lines, \%last_cl;

455

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

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

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

459 }

460 next;

461 }

462

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

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

465 my $before=$_;

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

467

468 my $re;

469 if (m/$cline_re_v2/) {

470 $re=$cline_re2_v2;

471 }

472 else {

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

474 $re=$cline_re2_v3;

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

476 }

477 m/$re/gs;

478

479 $commandlines_loaded++;

480 $last_output_length=0;

481

482 # Previous command

483 my %last_cl = %cl;

484

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

486 # Parse new command

487 my $this_line = $1;

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

489 my $err = $3;

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

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

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

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

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

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

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

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

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

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

500

501 {

502 use bytes;

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

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

505 }

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

507

508 $cl{"err"} = 0;

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

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

511

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

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

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

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

516 $cline_vt->reset();

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

518

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

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

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

522 $cl{"last_command"}

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

524

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

526

527 if (

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

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

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

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

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

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

534 ) {

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

536 }

537 else {

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

539 }

540 $skip_info = 0;

541

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

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

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

545 }

546

547 if (defined($last_cl{time})

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

549 bind_diff(\%last_cl);

550 }

551

552 # Error code

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

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

555

556 # Output

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

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

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

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

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

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

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

564 }

565 }

566 else {

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

568 }

569

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

571

572

573 # Changing encoding

574 for (keys %last_cl) {

575 next if /raw/;

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

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

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

579 }

580 }

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

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

583 push @Command_Lines, \%last_cl;

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

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

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

587 }

588 next;

589 }

590

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

592

593 $last_output_length+=length($_);

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

595 if ($last_output_length < 50000) {

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

597 }

598 else

599 {

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

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

602 $skip_info = 1;

603 }

604 }

605 }

606 close(FILE);

607

608 }

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

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

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

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

613 }

614 }

615

616

617

618

619 sub sort_command_lines

620 {

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

622

623 # Sort Command_Lines

624 # Write Command_Lines to Command_Lines_Index

625

626 my @index;

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

628 $index[$i]=$i;

629 }

630

631 @Command_Lines_Index = sort {

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

647 : 0

648 } @index;

649

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

651

652 }

653

654 sub printq

655 {

656 my $TO = shift;

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

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

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

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

661 print $TO $text;

662 }

663

664

665 =cut

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

667 =cut

668

669 sub print_command_lines

670 {

671 my $output_filename=$_[0];

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

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

674

675

676 my $cl;

677 my $in_range=0;

678 for my $i (@Command_Lines_Index) {

679 $cl = $Command_Lines[$i];

680

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

682 $in_range=1;

683 next;

684 }

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

686 $in_range=0;

687 next;

688 }

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

690 ||

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

692 ||

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

694 ||

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

696

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

698

699 my $output="";

700

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

702 && ($Config{"head_lines"}

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

704 # Partialy output

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

706 # head

707 my $mark=1;

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

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

710 }

711 # tail

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

713 if ($start < 0) {

714 $start=0;

715 $mark=0;

716 }

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

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

719 $mark=0;

720 }

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

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

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

724 }

725 }

726 else {

727 # Full output

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

729 }

730

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

732

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

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

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

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

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

738

739 my $year = 2005;

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

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

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

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

744

745

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

747 print OUT "<command>\n";

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

749 for my $element (qw(

750 local_session_id

751 history

752 uid

753 pid

754 time

755 pwd

756 raw_start

757 raw_output_start

758 raw_end

759 raw_file

760 tty

761 err

762 last_command

763 history

764 nonce

765 )) {

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

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

768 }

769 for my $element (qw(

770 prompt

771 cline

772 )) {

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

774 print OUT "<$element>";

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

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

777 }

778 #note

779 #note_title

780 print OUT "<output>";

781 printq(\*OUT,$output);

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

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

784 print OUT "<diff>";

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

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

787 }

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

789

790 }

791

792 close(OUT);

793 }

794

795 sub print_session

796 {

797 my $output_filename = $_[0];

798 my $local_session_id = $_[1];

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

800

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

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

803

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

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

806 print OUT "<session>\n";

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

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

809 for my $key (keys %session) {

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

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

812 }

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

814 close(OUT);

815 }

816

817 sub send_cache

818 {

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

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

821 #

822 my $cache_was_sent=0;

823

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

825 local $/;

826 my $cache = <CACHE>;

827 close(CACHE);

828

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

830 PeerAddr => $Config{backend_address},

831 PeerPort => $Config{backend_port},

832 proto => "tcp",

833 Type => SOCK_STREAM

834 );

835

836 if ($socket) {

837 print $socket $cache;

838 close($socket);

839 $cache_was_sent = 1;

840 }

841 }

842 return $cache_was_sent;

843 }

844

845 sub save_cache_stat

846 {

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

848 for my $f (keys %Script_Files) {

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

850 }

851 close(CACHE);

852 }

853

854 sub load_cache_stat

855 {

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

857 while(<CACHE>) {

858 chomp;

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

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

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

862 }

863 close(CACHE);

864 };

865 }

866

867

868 main();

869

870 sub process_was_killed

871 {

872 $Killed = 1;

873 }

874

875 sub reload

876 {

877 init_config;

878 }

879

880 sub main

881 {

882

883 $| = 1;

884

885 init_variables();

886 init_config();

887

888

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

890

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

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

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

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

895

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

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

898 close(CACHE);

899 };

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

901 sort_command_lines;

902 #process_command_lines;

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

904 }

905 else {

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

907 my $pid = <PIDFILE>;

908 close(PIDFILE);

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

910 print "Removing stale pidfile\n";

911 unlink $Config{agent_pidfile}

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

913 }

914 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`) {

915 print "Removing stale pidfile\n";

916 unlink $Config{agent_pidfile}

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

918 }

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

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

921 exit(0);

922 }

923 else {

924 print "Unknown operating system";

925 exit(0);

926 }