#!/usr/bin/perl -w # # (c) Igor Chubin, imchubin@mail.ru, 2004 # use strict; use Getopt::Long; use Term::VT102; use Text::Iconv; use Data::Dumper; our $Config_File = "labmaker.conf"; our %Config = ( "skip_empty" => "yes", "skip_interrupted" => "no", "skip_wrong" => "no", "editors" => ["vi", "pico", "ee", "vim"], "pagers" => ["more", "less", "zmore", "zless", "info", "man", "mc", "trafshow", "screen", "cfdisk", "trafshow-bsd", "yes", "lynx", "links", "centericq" ], "terminal" => ["mc"], "suppress_editors" => "yes", "suppress_pagers" => "yes", "suppress_terminal" => "yes", "terminal_width" => 100, "terminal_height" => 100, "verbose" => "yes", "head_lines" => 5, "tail_lines" => 5, "skip_text" => "...", "show_time" => "yes", "show_diffs" => "yes", "show_comments" => "yes", "input" => "/root/.labmaker", "diffs" => "", "input_mask" => "*.script", "encoding" => "utf-8", "output" => "/var/www/lm/reportINDEX.html", #"output" => "report.xml", "output_mask" => "INDEX", "output_format" => "html", "signature" => "#lm:", "from" => "", "to" => "", "lab" => "", "keywords" => "linux command", "files_keywords" => "linux file", comment_width => "300", time_width => "60", "course-name" => "", "course-code" => "", "course-date" => "", "course-center" => "", "course-trainer" => "", "course-student" => "", ); our @Command_Lines; our @Command_Lines_Index; our @Diffs; our %Commands_Stat; # Statistics about commands usage our %Files_Stat; # Statistics about commands usage our %Search_Machines = ( "google" => { "query" => "http://www.google.com/search?q=" , "icon" => "google.ico" }, "freebsd" => { "query" => "http://www.freebsd.org/cgi/man.cgi?query=", "icon" => "freebsd.ico" }, "linux" => { "query" => "http://man.he.net/?topic=", "icon" => "linux.ico"}, "opennet" => { "query" => "http://www.opennet.ru/search.shtml?words=", "icon" => "opennet.ico"}, "local" => { "query" => "http://www.freebsd.org/cgi/man.cgi?query=", "icon" => "freebsd.ico" }, ); our %Elements_Visibility = ( "note" => "замечания", "diff" => "редактор", "time" => "время", "ttychange" => "терминал", "wrong_output wrong_cline wrong_root_output wrong_root_cline" => "команды с ошибками", "interrupted_output interrupted_cline interrupted_root_output interrupted_root_cline" => "прерванные команды", "tab_completion_output tab_completion_cline" => "продолжение с помощью tab" ); sub init_variables; our $Html_Help; our $Html_About; sub load_diff_files { my @pathes = @_; for my $path (@pathes) { my $template = "*.diff"; my @files = <$path/$template>; my $i=0; for my $file (@files) { my %diff; $diff{"path"}=$path; $diff{"uid"}="SET THIS"; # Сейчас UID определяется из названия каталога # откуда берутся diff-файлы # Это неправильно # # ВАРИАНТ: # К файлам жураналам должны прилагаться ситемны файлы, # мз которых и будет определяться соответствие # имён пользователей их uid'ам # $diff{"uid"} = 0 if $path =~ m@/root/@; $diff{"bind_to"}=""; $diff{"time_range"}=-1; next if not $file=~m@/(D?[0-9][0-9]?[0-9]?)[^/]*?([0-9]*):([0-9]*):?([0-9]*)@; $diff{"day"}=$1 || ""; $diff{"hour"}=$2; $diff{"min"}=$3; $diff{"sec"}=$4 || 0; $diff{"index"}=$i; print "diff loaded: $diff{day} $diff{hour}:$diff{min}:$diff{sec}\n"; local $/; open (F, "$file") or return "Can't open file $file ($_[0]) for reading"; my $text = ; if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i) { my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8"); $text = $converter->convert($text); } close(F); $diff{"text"}=$text; #print "$file loaded ($diff{day})\n"; push @Diffs, \%diff; $i++; } } } sub bind_diff { # my $path = shift; # my $pid = shift; # my $day = shift; # my $lab = shift; print "Trying to bind diff...\n"; my $cl = shift; my $hour = $cl->{"hour"}; my $min = $cl->{"min"}; my $sec = $cl->{"sec"}; my $min_dt = 10000; for my $diff (@Diffs) { # Check here date, time and user next if ($diff->{"day"} && $cl->{"day"} && ($cl->{"day"} ne $diff->{"day"})); #next if (!$diff->{"uid"} && $cl->{"euid"} != $diff->{"uid"}); my $dt=($diff->{"hour"}-$hour)*3600 +($diff->{"min"}-$min)*60 + ($diff->{"sec"}-$sec); if ($dt >0 && $dt < $min_dt && ($diff->{"time_range"} <0 || $dt < $diff->{"time_range"})) { print "Approppriate diff found: dt=$dt\n"; if ($diff->{"bind_to"}) { undef $diff->{"bind_to"}->{"diff"}; }; $diff->{"time_range"}=$dt; $diff->{"bind_to"}=$cl; $cl->{"diff"} = $diff->{"index"}; $min_dt = $dt; } } } sub extract_from_cline # Разобрать командную строку $_[1] и возвратить хэш, содержащий # номер первого появление команды в строке: # команда => первая позиция { my $what = $_[0]; my $cline = $_[1]; my @lists = split /\;/, $cline; my @commands = (); for my $list (@lists) { push @commands, split /\|/, $list; } my %commands; my %files; my $i=0; for my $command (@commands) { $command =~ /\s*(\S+)\s*(.*)/; if ($1 && $1 eq "sudo" ) { $commands{"$1"}=$i++; $command =~ s/\s*sudo\s+//; } $command =~ /\s*(\S+)\s*(.*)/; if ($1 && !defined $commands{"$1"}) { $commands{"$1"}=$i++; }; if ($2) { my $args = $2; my @args = split (/\s+/, $args); for my $a (@args) { $files{"$a"}=$i++ if !defined $files{"$a"}; }; } } if ($what eq "commands") { return %commands; } else { return %files; } } sub load_command_lines { my $lab_scripts_path = $_[0]; my $lab_scripts_mask = $_[1]; my $cline_re_base = qq' (?:\\^?([0-9]*C?)) # exitcode (?:_([0-9]+)_)? # uid (?:_([0-9]+)_) # pid (...?) # day (.?.?) # lab \\s # space separator ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) # time .\\[50D.\\[K # killing symbols (.*?([\$\#]\\s?)) # prompt (.*) # command line '; #my $cline_re = qr/$cline_re_base(?:$cline_re_base|$)/x; #my $cline_re = qr/(?:$cline_re_base)*$cline_re_base$/x; my $cline_re = qr/$cline_re_base/sx; my $cline_re1 = qr/$cline_re_base\x0D/sx; my $cline_re2 = qr/$cline_re_base$/sx; my $vt = Term::VT102->new ( 'cols' => $Config{"terminal_width"}, 'rows' => $Config{"terminal_height"}); my $cline_vt = Term::VT102->new ('cols' => $Config{"terminal_width"}, 'rows' => $Config{"terminal_height"}); my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8") if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i); print "Loading lm-scripts...\n" if $Config{"verbose"} =~ /y/; my @lab_scripts = <$lab_scripts_path/$lab_scripts_mask>; my $file; my $files_number = $#lab_scripts; my $ii = 0; my $skip_info; my $commandlines_loaded =0; my $commandlines_processed =0; for $file (@lab_scripts){ #printf "\t%i %3.2f\n", $ii, (100*$ii++/$files_number) if $Config{"verbose"} =~ /y/; open (FILE, "$file"); binmode FILE; $file =~ m@.*/(.*?)-.*@; my $tty = $1; my $first_pass = 1; my %cl; my $last_output_length=0; while () { $commandlines_processed++; # time if (/[0-9][0-9]:[0-9][0-9]:[0-9][0-9].\[[0-9][0-9]D.\[K/ && m/$cline_re/) { s/.*\x0d(?!\x0a)//; # print "!!!",$_,"!!!\n"; # next; # while (m/$cline_re1/gs) { # } m/$cline_re2/gs; $commandlines_loaded++; $last_output_length=0; # Previous command my %last_cl = %cl; my $err = $1 || ""; # Parse new command $cl{"uid"} = $2; $cl{"euid"} = $cl{"uid"}; # Если в команде обнаружится sudo, euid поменяем на 0 $cl{"pid"} = $3; $cl{"day"} = $4; $cl{"lab"} = $5; $cl{"hour"} = $6; $cl{"min"} = $7; $cl{"sec"} = $8; $cl{"fullprompt"} = $9; $cl{"prompt"} = $10; $cl{"raw_cline"} = $11; $cl{"err"} = 0; $cl{"output"} = ""; $cl{"tty"} = $tty; $cline_vt->process($cl{"raw_cline"}."\n"); $cl{"cline"} = $cline_vt->row_plaintext (1); $cl{"cline"} =~ s/\s*$//; $cline_vt->reset(); my %commands = extract_from_cline("commands", $cl{"cline"}); $cl{"euid"}=0 if defined $commands{"sudo"}; my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands; $cl{"last_command"} = $comms[$#comms] || ""; if ( $Config{"suppress_editors"} =~ /^y/i && grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}}) || $Config{"suppress_pagers"} =~ /^y/i && grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}}) || $Config{"suppress_terminal"}=~ /^y/i && grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}}) ) { $cl{"suppress_output"} = "1"; } else { $cl{"suppress_output"} = "0"; } $skip_info = 0; print " ",$cl{"last_command"}; # Processing previous command line if ($first_pass) { $first_pass = 0; next; } # Error code $last_cl{"err"}=$err; $last_cl{"err"}=130 if $err eq "^C"; if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) { bind_diff(\%last_cl); } # Output if (!$last_cl{"suppress_output"} || $last_cl{"err"}) { for (my $i=0; $i<$Config{"terminal_height"}; $i++) { my $line= $vt->row_plaintext($i); next if !defined ($line) || $line =~ /^\s*$/; $line =~ s/\s*$//; $last_cl{"output"} .= $line."\n"; } } else { $last_cl{"output"}= ""; } $vt->reset(); # Classifying the command line # Save if (!$Config{"lab"} || $cl{"lab"} eq $Config{"lab"}) { # Changing encoding for (keys %last_cl) { $last_cl{$_} = $converter->convert($last_cl{$_}) if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i); } push @Command_Lines, \%last_cl; } next; } $last_output_length+=length($_); #if (!$cl{"suppress_output"} || $last_output_length < 5000) { if ($last_output_length < 50000) { #print "(",length($_),")" if (length($_) > 2000) ; $vt->process("$_"."\n") } else { if (!$skip_info) { print "($cl{last_command})"; $skip_info = 1; } } } close(FILE); } if ($Config{"verbose"} =~ /y/) { print "...finished." ; print "Lines loaded: $commandlines_processed\n"; print "Command lines: $commandlines_loaded\n"; } } sub search_by { my $sm = shift; my $topic = shift; $topic =~ s/ /+/; return ""; } sub make_comment { my $commands = $_[0]; my $files = $_[1]; chomp $commands; chomp $files; return if (!$commands && !$files); my $comment=""; # Commands for my $command (split /\s+/,$commands) { $command =~ s/'//g; my $description=""; eval { $description=`mywi-client '$command'`; } ; $description = join ("
\n", grep(/\([18]\)/, split(/\n/, $description))); $description =~ s/.*?-//; next if $description =~ /^\s*$/; my $query=$command." ".$Config{"keywords"}; $query =~ s/\ /+/g; my $search= search_by("opennet",$query). search_by("local",$command). search_by("google",$query); $comment .= "$command". "$search". "". "$description"; } # Files for my $file (split /\s+/,$files) { $file =~ s@.*/@@; $file =~ s/'//g; next if $file =~ /^\s*$/; next if $file =~ /^-/; my $description=`mywi '$file'`; $description = join ("
\n", grep(/\(5\)/, split(/\n/, $description))); next if $description =~ /^\s*$/; my $query=$file." ".$Config{"files_keywords"}; $query =~ s/\ /+/g; my $search= search_by("opennet",$query). search_by("local",$file). search_by("google",$query); $comment .= "$file". "$search". "". "$description"; } return $comment; } sub printq { my $TO = shift; my $text = join "", @_; $text =~ s/&/&/g; $text =~ s//>/g; print $TO $text; } sub sort_command_lines { print "Sorting command lines...\n" if $Config{"verbose"} =~ /y/; # Sort Command_Lines # Write Command_Lines to Command_Lines_Index my @index; for (my $i=0;$i<=$#Command_Lines;$i++) { $index[$i]=$i; } @Command_Lines_Index = sort { $Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"} || $Command_Lines[$index[$a]]->{"hour"} <=> $Command_Lines[$index[$b]]->{"hour"} || $Command_Lines[$index[$a]]->{"min"} <=> $Command_Lines[$index[$b]]->{"min"} || $Command_Lines[$index[$a]]->{"sec"} <=> $Command_Lines[$index[$b]]->{"sec"} } @index; print "...finished\n" if $Config{"verbose"} =~ /y/; } sub process_command_lines { my $lab_scripts_path = $_[0]; for my $i (@Command_Lines_Index) { my $cl = \$Command_Lines[$i]; @{${$cl}->{"new_commands"}} =(); @{${$cl}->{"new_files"}} =(); $$cl->{"class"} = ""; if ($$cl->{"err"}) { $$cl->{"class"}="wrong"; $$cl->{"class"}="interrupted" if ($$cl->{"err"} eq 130); } if (!$$cl->{"euid"}) { $$cl->{"class"}.="_root"; } #tab# my @tab_words=split /\s+/, $$cl->{"output"}; #tab# my $last_word= $$cl->{"cline"} =~ /(\S*)$/; #tab# $last_word =~ s@.*/@@; #tab# my $this_is_tab=1; #tab# #tab# if ($last_word && @tab_words >2) { #tab# for my $tab_words (@tab_words) { #tab# if ($tab_words !~ /^$last_word/) { #tab# $this_is_tab=0; #tab# last; #tab# } #tab# } #tab# } #tab# $$cl->{"class"}="tab" if $this_is_tab; if ( !$$cl->{"err"}) { # Command does not contain mistakes my %commands = extract_from_cline("commands", ${$cl}->{"cline"}); my %files = extract_from_cline("files", ${$cl}->{"cline"}); # Searching for new commands only for my $command (keys %commands) { if (!defined $Commands_Stat{$command}) { push @{$$cl->{new_commands}}, $command; } $Commands_Stat{$command}++; } for my $file (keys %files) { if (!defined $Files_Stat{$file}) { push @{$$cl->{new_files}}, $file; } $Files_Stat{$file}++; } } } } =cut Вывести результат обработки журнала. =cut sub print_command_lines { my $output_filename=$_[0]; my $format = $Config{"output_format"}; my $course_name = $Config{"course-name"}; my $course_code = $Config{"course-code"}; my $course_date = $Config{"course-date"}; my $course_center = $Config{"course-center"}; my $course_trainer = $Config{"course-trainer"}; my $course_student = $Config{"course-student"}; open(OUT, ">", $output_filename) or die "Can't open $output_filename for writing\n"; if ($format eq "html") { # vvvv HTML Header print OUT <

Журнал лабораторных работ

Выполнил $course_student
Проверил $course_trainer
Курс $course_name ($course_code), $course_date
Учебный центр $course_center

Журнал

HEADER print OUT "
\n"; for my $element (keys %Elements_Visibility) { my @e = split /\s+/, $element; my $showhide = join "", map { "ShowHide('$_');" } @e ; print OUT "", $Elements_Visibility{$element}, "
\n"; } #print OUT "". #"
\n"; #print OUT "". #"
\n"; print OUT "
\n"; print OUT "\n"; # ^^^^ HTML Header } else { # XML Header print OUT "\n"; } close(OUT); } sub read_config_file { my $config = $_[0]; my $filename = $_[1]; open(CONFIG, "$filename") or return; while () { s/#.*//; next if /^\s*$/; my ($var, $val) = split /\s*=\s*/, $_, 2; $var =~ s/\s*//; $config->{$var} = $val; } close(CONFIG); } sub print_command_lines2 { my $output_filename=$_[0]; open(OUT, ">", $output_filename) or die "Can't open $output_filename for writing\n"; print OUT < OUT my $cl; for my $i (@Command_Lines_Index) { $cl = $Command_Lines[$i]; # Printing out print OUT < $cl->{day} $cl->{hour} $cl->{min} $cl->{sec} $cl->{tty} $cl->{uid} $cl->{euid} $cl->{prompt} $cl->{cline} $cl->{err} $cl->{output} OUT } for my $diff (@Diffs) { print OUT < $diff->{path} $diff->{uid} $diff->{day} $diff->{hour} $diff->{min} $diff->{sec} $diff->{text} OUT } print OUT < OUT } $| = 1; my %file_config; my %argv_config; init_variables; read_config_file(\%file_config, $Config_File); GetOptions(\%argv_config, map "$_=s", keys %Config); %Config = (%Config, %file_config, %argv_config); my $i=0; for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) { load_diff_files($lab_log); } for my $lab_log (split /\s+/, $Config{"input"}) { my $tofile=$Config{"output"}; $tofile =~ s/$Config{"output_mask"}/$i/; #load_diff_files($lab_log); load_command_lines($lab_log, $Config{"input_mask"}); sort_command_lines; process_command_lines($lab_log); print_command_lines($tofile); $i++; } sub init_variables { $Html_Help = < LiLaLo (L3) расшифровывается как Live Lab Log.
Программа разработана для повышения эффективности обучения
Unix/Linux-системам.
(c) Игорь Чубин, 2004-2005

ABOUT $Html_About.='$Id$

'; }