lilalo

annotate l3-frontend @ 101:c41cc9a4b5ea

find changesets by author, revision, files, or words in the commit message
* Пофиксил ошибку с неправильной кодировкой mywi-хинтов.
* Подготовил к переходу в иерархию /l3/
** Исправил пути для стилей,
** Забацал красивый l3-cgi-lite


l3-cgi-lite пока что не доделан до нужного уровня,
но я его скоро дорисую.
Уже сейчас это намного более качественный скрипт
через уродский l3-cgi

Он, конечно, поработал в свое время,
но лучше его заменить l3-cgi-lite


Из функционала добавилось:
* Кэширование страниц в html
* Навигация по каталогам
* Навигационная строка в журнале сверху
author devi
date Sat Jun 24 22:53:37 2006 +0300 (2006-06-24)
parents 05e99d32f1f5
children 6fce4641575b
rev   line source
devi@23 1 #!/usr/bin/perl -w
devi@23 2
devi@31 3 use IO::Socket;
devi@23 4 use lib '.';
devi@23 5 use l3config;
devi@88 6 use utf8;
devi@23 7
devi@23 8 our @Command_Lines;
devi@31 9 our @Command_Lines_Index;
devi@31 10 our %Commands_Description;
devi@31 11 our %Args_Description;
devi@31 12 our $Mywi_Socket;
devi@32 13 our %Sessions;
devi@89 14
devi@84 15 our %filter;
devi@89 16 our $filter_url;
devi@89 17 sub init_filter;
devi@23 18
devi@69 19 our %Files;
devi@69 20
devi@23 21 # vvv Инициализация переменных выполняется процедурой init_variables
devi@23 22 our @Day_Name;
devi@23 23 our @Month_Name;
devi@23 24 our @Of_Month_Name;
devi@23 25 our %Search_Machines;
devi@23 26 our %Elements_Visibility;
devi@23 27 # ^^^
devi@23 28
devi@31 29 our %Stat;
devi@87 30 our %frequency_of_command; # Сколько раз в журнале встречается какая команда
devi@63 31 our $table_number=1;
devi@31 32
devi@55 33 my %mywi_cache_for; # Кэш для экономии обращений к mywi
devi@55 34
devi@23 35 sub make_comment;
devi@63 36 sub make_new_entries_table;
devi@23 37 sub load_command_lines_from_xml;
devi@32 38 sub load_sessions_from_xml;
devi@31 39 sub sort_command_lines;
devi@31 40 sub process_command_lines;
devi@23 41 sub init_variables;
devi@23 42 sub main;
devi@31 43 sub collapse_list($);
devi@23 44
devi@87 45 sub minutes_passed;
devi@87 46
devi@88 47 sub print_all_txt;
devi@88 48 sub print_all_html;
devi@89 49 sub print_edit_all_html;
devi@88 50 sub print_command_lines_html;
devi@89 51 sub print_command_lines_txt;
devi@88 52 sub print_files_html;
devi@88 53 sub print_stat_html;
devi@88 54 sub print_header_html;
devi@88 55 sub print_footer_html;
devi@56 56
devi@23 57 main();
devi@23 58
devi@23 59 sub main
devi@23 60 {
devi@49 61 $| = 1;
devi@23 62
devi@49 63 init_variables();
devi@49 64 init_config();
devi@68 65 $Config{frontend_ico_path}=$Config{frontend_css};
devi@68 66 $Config{frontend_ico_path}=~s@/[^/]*$@@;
devi@89 67 init_filter();
devi@23 68
devi@49 69 open_mywi_socket();
devi@49 70 load_command_lines_from_xml($Config{"backend_datafile"});
devi@49 71 load_sessions_from_xml($Config{"backend_datafile"});
devi@49 72 sort_command_lines;
devi@49 73 process_command_lines;
devi@89 74 if (defined($filter{action}) && $filter{action} eq "edit") {
devi@89 75 print_edit_all_html($Config{"output"});
devi@89 76 }
devi@89 77 else {
devi@89 78 print_all_html($Config{"output"});
devi@89 79 }
devi@49 80 close_mywi_socket;
devi@23 81 }
devi@23 82
devi@89 83 sub init_filter
devi@89 84 {
devi@89 85 if ($Config{filter}) {
devi@89 86 # Инициализация фильтра
devi@89 87 for (split /&/,$Config{filter}) {
devi@89 88 my ($var, $val) = split /=/;
devi@89 89 $filter{$var} = $val || "";
devi@89 90 }
devi@89 91 }
devi@89 92 $filter_url = join ("&", map("$_=$filter{$_}", keys %filter));
devi@89 93 }
devi@89 94
devi@56 95 # extract_from_cline
devi@23 96
devi@56 97 # In: $what = commands | args
devi@56 98 # Out: return ссылка на хэш, содержащий результаты разбора
devi@56 99 # команда => позиция
devi@23 100
devi@31 101 # Разобрать командную строку $_[1] и возвратить хэш, содержащий
devi@31 102 # номер первого появление команды в строке:
devi@49 103 # команда => первая позиция
devi@56 104 sub extract_from_cline
devi@31 105 {
devi@49 106 my $what = $_[0];
devi@49 107 my $cline = $_[1];
devi@49 108 my @lists = split /\;/, $cline;
devi@49 109
devi@49 110
devi@56 111 my @command_lines = ();
devi@56 112 for my $command_list (@lists) {
devi@56 113 push(@command_lines, split(/\|/, $command_list));
devi@49 114 }
devi@31 115
devi@56 116 my %position_of_command;
devi@56 117 my %position_of_arg;
devi@49 118 my $i=0;
devi@56 119 for my $command_line (@command_lines) {
devi@56 120 $command_line =~ s@^\s*@@;
devi@56 121 $command_line =~ /\s*(\S+)\s*(.*)/;
devi@49 122 if ($1 && $1 eq "sudo" ) {
devi@56 123 $position_of_command{"$1"}=$i++;
devi@56 124 $command_line =~ s/\s*sudo\s+//;
devi@49 125 }
devi@56 126 if ($command_line !~ m@^\s*\S*/etc/@) {
devi@56 127 $command_line =~ s@^\s*\S+/@@;
devi@56 128 }
devi@56 129
devi@56 130 $command_line =~ /\s*(\S+)\s*(.*)/;
devi@56 131 my $command = $1;
devi@56 132 my $args = $2;
devi@56 133 if ($command && !defined $position_of_command{"$command"}) {
devi@56 134 $position_of_command{"$command"}=$i++;
devi@49 135 };
devi@56 136 if ($args) {
devi@49 137 my @args = split (/\s+/, $args);
devi@49 138 for my $a (@args) {
devi@56 139 $position_of_arg{"$a"}=$i++
devi@56 140 if !defined $position_of_arg{"$a"};
devi@49 141 };
devi@49 142 }
devi@49 143 }
devi@31 144
devi@49 145 if ($what eq "commands") {
devi@56 146 return \%position_of_command;
devi@49 147 } else {
devi@56 148 return \%position_of_arg;
devi@49 149 }
devi@49 150
devi@31 151 }
devi@31 152
devi@56 153
devi@56 154
devi@56 155
devi@56 156 #
devi@56 157 # Подпрограммы для работы с mywi
devi@56 158 #
devi@56 159
devi@31 160 sub open_mywi_socket
devi@31 161 {
devi@49 162 $Mywi_Socket = IO::Socket::INET->new(
devi@49 163 PeerAddr => $Config{mywi_server},
devi@49 164 PeerPort => $Config{mywi_port},
devi@49 165 Proto => "tcp",
devi@49 166 Type => SOCK_STREAM);
devi@31 167 }
devi@31 168
devi@31 169 sub close_mywi_socket
devi@31 170 {
devi@52 171 close ($Mywi_Socket) if $Mywi_Socket ;
devi@31 172 }
devi@31 173
devi@31 174
devi@31 175 sub mywi_client
devi@31 176 {
devi@101 177 #return "";
devi@49 178 my $query = $_[0];
devi@49 179 my $mywi;
devi@31 180
devi@49 181 open_mywi_socket;
devi@49 182 if ($Mywi_Socket) {
devi@101 183 binmode ":utf8", $Mywi_Socket;
devi@49 184 local $| = 1;
devi@49 185 local $/ = "";
devi@49 186 print $Mywi_Socket $query."\n";
devi@49 187 $mywi = <$Mywi_Socket>;
devi@101 188 utf8::decode($mywi);
devi@49 189 $mywi = "" if $mywi =~ /nothing app/;
devi@49 190 }
devi@49 191 close_mywi_socket;
devi@49 192 return $mywi;
devi@31 193 }
devi@31 194
devi@23 195 sub make_comment
devi@23 196 {
devi@49 197 my $cline = $_[0];
devi@49 198 #my $files = $_[1];
devi@23 199
devi@55 200 my @comments;
devi@49 201 my @commands = keys %{extract_from_cline("commands", $cline)};
devi@49 202 my @args = keys %{extract_from_cline("args", $cline)};
devi@49 203 return if (!@commands && !@args);
devi@49 204 #return "commands=".join(" ",@commands)."; files=".join(" ",@files);
devi@23 205
devi@49 206 # Commands
devi@49 207 for my $command (@commands) {
devi@49 208 $command =~ s/'//g;
devi@87 209 $frequency_of_command{$command}++;
devi@49 210 if (!$Commands_Description{$command}) {
devi@55 211 $mywi_cache_for{$command} ||= mywi_client ($command) || "";
devi@63 212 my $mywi = join ("\n", grep(/\([18]|sh|script\)/, split(/\n/, $mywi_cache_for{$command})));
devi@49 213 $mywi =~ s/\s+/ /;
devi@49 214 if ($mywi !~ /^\s*$/) {
devi@49 215 $Commands_Description{$command} = $mywi;
devi@49 216 }
devi@49 217 else {
devi@49 218 next;
devi@49 219 }
devi@49 220 }
devi@23 221
devi@49 222 push @comments, $Commands_Description{$command};
devi@49 223 }
devi@49 224 return join("&#10;\n", @comments);
devi@49 225
devi@49 226 # Files
devi@49 227 for my $arg (@args) {
devi@49 228 $arg =~ s/'//g;
devi@49 229 if (!$Args_Description{$arg}) {
devi@49 230 my $mywi;
devi@49 231 $mywi = mywi_client ($arg);
devi@49 232 $mywi = join ("\n", grep(/\([5]\)/, split(/\n/, $mywi)));
devi@49 233 $mywi =~ s/\s+/ /;
devi@49 234 if ($mywi !~ /^\s*$/) {
devi@49 235 $Args_Description{$arg} = $mywi;
devi@49 236 }
devi@49 237 else {
devi@49 238 next;
devi@49 239 }
devi@49 240 }
devi@23 241
devi@49 242 push @comments, $Args_Description{$arg};
devi@49 243 }
devi@23 244
devi@23 245 }
devi@23 246
devi@23 247 =cut
devi@23 248 Процедура load_command_lines_from_xml выполняет загрузку разобранного lab-скрипта
devi@23 249 из XML-документа в переменную @Command_Lines
devi@23 250
devi@56 251 # In: $datafile имя файла
devi@56 252 # Out: @CommandLines загруженные командные строки
devi@56 253
devi@23 254 Предупреждение!
devi@23 255 Процедура не в состоянии обрабатывать XML-документ любой структуры.
devi@23 256 В действительности файл cache из которого загружаются данные
devi@23 257 просто напоминает XML с виду.
devi@23 258 =cut
devi@23 259 sub load_command_lines_from_xml
devi@23 260 {
devi@49 261 my $datafile = $_[0];
devi@23 262
devi@49 263 open (CLASS, $datafile)
devi@81 264 or die "Can't open file with xml lablog ",$datafile,"\n";
devi@49 265 local $/;
devi@89 266 binmode CLASS, ":utf8";
devi@49 267 $data = <CLASS>;
devi@49 268 close(CLASS);
devi@23 269
devi@49 270 for $command ($data =~ m@<command>(.*?)</command>@sg) {
devi@49 271 my %cl;
devi@49 272 while ($command =~ m@<([^>]*?)>(.*?)</\1>@sg) {
devi@49 273 $cl{$1} = $2;
devi@49 274 }
devi@49 275 push @Command_Lines, \%cl;
devi@49 276 }
devi@23 277 }
devi@23 278
devi@32 279 sub load_sessions_from_xml
devi@32 280 {
devi@49 281 my $datafile = $_[0];
devi@32 282
devi@89 283 open (CLASS, $datafile)
devi@81 284 or die "Can't open file with xml lablog ",$datafile,"\n";
devi@49 285 local $/;
devi@89 286 binmode CLASS, ":utf8";
devi@49 287 my $data = <CLASS>;
devi@49 288 close(CLASS);
devi@32 289
devi@84 290 my $i=0;
devi@84 291 for my $session ($data =~ m@<session>(.*?)</session>@msg) {
devi@84 292 my %session_hash;
devi@49 293 while ($session =~ m@<([^>]*?)>(.*?)</\1>@sg) {
devi@84 294 $session_hash{$1} = $2;
devi@49 295 }
devi@84 296 $Sessions{$session_hash{local_session_id}} = \%session_hash;
devi@49 297 }
devi@32 298 }
devi@32 299
devi@32 300
devi@56 301 # sort_command_lines
devi@56 302 # In: @Command_Lines
devi@56 303 # Out: @Command_Lies_Index
devi@32 304
devi@31 305 sub sort_command_lines
devi@31 306 {
devi@31 307
devi@49 308 my @index;
devi@49 309 for (my $i=0;$i<=$#Command_Lines;$i++) {
devi@49 310 $index[$i]=$i;
devi@49 311 }
devi@31 312
devi@49 313 @Command_Lines_Index = sort {
devi@49 314 $Command_Lines[$index[$a]]->{"time"} <=> $Command_Lines[$index[$b]]->{"time"}
devi@49 315 } @index;
devi@31 316
devi@31 317 }
devi@31 318
devi@56 319 ##################
devi@56 320 # process_command_lines
devi@56 321 #
devi@56 322 # Обрабатываются командные строки @Command_Lines
devi@56 323 # Для каждой строки определяется:
devi@56 324 # class класс
devi@56 325 # note комментарий
devi@56 326 #
devi@56 327 # In: @Command_Lines_Index
devi@56 328 # In-Out: @Command_Lines
devi@56 329
devi@31 330 sub process_command_lines
devi@31 331 {
devi@89 332
devi@89 333 COMMAND_LINE_PROCESSING:
devi@49 334 for my $i (@Command_Lines_Index) {
devi@56 335 my $cl = \$Command_Lines[$i];
devi@31 336
devi@56 337 next if !$cl;
devi@31 338
devi@89 339 for my $filter_key (keys %filter) {
devi@89 340 next COMMAND_LINE_PROCESSING
devi@89 341 if defined($$cl->{local_session_id})
devi@89 342 && defined($Sessions{$$cl->{local_session_id}}->{$filter_key})
devi@89 343 && $Sessions{$$cl->{local_session_id}}->{$filter_key} ne $filter{$filter_key};
devi@89 344 }
devi@89 345
devi@73 346 $$cl->{id} = $$cl->{"time"};
devi@73 347
devi@56 348 $$cl->{err} ||=0;
devi@56 349
devi@56 350 # Класс команды
devi@56 351
devi@56 352 $$cl->{"class"} = $$cl->{"err"} eq 130 ? "interrupted"
devi@56 353 : $$cl->{"err"} eq 127 ? "mistyped"
devi@56 354 : $$cl->{"err"} ? "wrong"
devi@57 355 : "normal";
devi@56 356
devi@73 357 if ($$cl->{"cline"} &&
devi@73 358 $$cl->{"cline"} =~ /[^|`]\s*sudo/
devi@57 359 || $$cl->{"uid"} eq 0) {
devi@49 360 $$cl->{"class"}.="_root";
devi@49 361 }
devi@31 362
devi@91 363 my $hint;
devi@91 364 $hint = make_comment($$cl->{"cline"});
devi@91 365 if ($hint) {
devi@91 366 $$cl->{hint} = $hint;
devi@91 367 }