| rev | line source | 
| devi@23 | 1 #!/usr/bin/perl -w | 
| devi@23 | 2 | 
| devi@23 | 3 # | 
| devi@23 | 4 # (c) Igor Chubin, imchubin@mail.ru, 2004-2005 | 
| devi@23 | 5 # | 
| devi@23 | 6 | 
| devi@23 | 7 use strict; | 
| devi@23 | 8 use Term::VT102; | 
| devi@23 | 9 use Text::Iconv; | 
| devi@23 | 10 use Data::Dumper; | 
| devi@23 | 11 use Time::Local 'timelocal_nocheck'; | 
| devi@23 | 12 | 
| devi@23 | 13 use lib "."; | 
| devi@23 | 14 use l3config; | 
| devi@23 | 15 | 
| devi@23 | 16 | 
| devi@23 | 17 our @Command_Lines; | 
| devi@23 | 18 our @Command_Lines_Index; | 
| devi@23 | 19 our @Diffs; | 
| devi@23 | 20 | 
| devi@23 | 21 our %Commands_Stat;		# Statistics about commands usage | 
| devi@23 | 22 our %Files_Stat;		# Statistics about commands usage | 
| devi@23 | 23 | 
| devi@23 | 24 | 
| devi@23 | 25 sub init_variables; | 
| devi@23 | 26 sub main; | 
| devi@23 | 27 | 
| devi@23 | 28 sub load_diff_files; | 
| devi@23 | 29 sub bind_diff; | 
| devi@23 | 30 sub extract_from_cline; | 
| devi@23 | 31 sub load_command_lines; | 
| devi@23 | 32 sub sort_command_lines; | 
| devi@23 | 33 sub process_command_lines; | 
| devi@23 | 34 sub print_command_lines; | 
| devi@23 | 35 sub printq; | 
| devi@23 | 36 | 
| devi@23 | 37 sub load_diff_files | 
| devi@23 | 38 { | 
| devi@23 | 39 	my @pathes = @_; | 
| devi@23 | 40 | 
| devi@23 | 41 	for my $path (@pathes) { | 
| devi@23 | 42 		my $template = "*.diff"; | 
| devi@23 | 43 		my @files = <$path/$template>; | 
| devi@23 | 44 		my $i=0; | 
| devi@23 | 45 		for my $file (@files) { | 
| devi@23 | 46 			my %diff; | 
| devi@23 | 47 | 
| devi@23 | 48 			$diff{"path"}=$path; | 
| devi@23 | 49 			$diff{"uid"}="SET THIS"; | 
| devi@23 | 50 | 
| devi@23 | 51 # Сейчас UID определяется из названия каталога | 
| devi@23 | 52 # откуда берутся diff-файлы | 
| devi@23 | 53 # Это неправильно | 
| devi@23 | 54 # | 
| devi@23 | 55 # ВАРИАНТ: | 
| devi@23 | 56 # К файлам жураналам должны прилагаться ситемны файлы, | 
| devi@23 | 57 # мз которых и будет определяться соответствие | 
| devi@23 | 58 # имён пользователей их uid'ам | 
| devi@23 | 59 # | 
| devi@23 | 60 			$diff{"uid"} = 0 if $path =~ m@/root/@; | 
| devi@23 | 61 | 
| devi@23 | 62 			$diff{"bind_to"}=""; | 
| devi@23 | 63 			$diff{"time_range"}=-1; | 
| devi@23 | 64 | 
| devi@23 | 65 			next if not $file=~m@/(D?[0-9][0-9]?[0-9]?)[^/]*?([0-9]*):([0-9]*):?([0-9]*)@; | 
| devi@23 | 66 			$diff{"day"}=$1 || ""; | 
| devi@23 | 67 			$diff{"hour"}=$2; | 
| devi@23 | 68 			$diff{"min"}=$3; | 
| devi@23 | 69 			$diff{"sec"}=$4 || 0; | 
| devi@23 | 70 | 
| devi@23 | 71 			$diff{"index"}=$i; | 
| devi@23 | 72 | 
| devi@23 | 73 			print "diff loaded: $diff{day} $diff{hour}:$diff{min}:$diff{sec}\n"; | 
| devi@23 | 74 | 
| devi@23 | 75 			local $/; | 
| devi@23 | 76 			open (F, "$file") | 
| devi@23 | 77 				or return "Can't open file $file ($_[0]) for reading"; | 
| devi@23 | 78 			my $text = <F>; | 
| devi@23 | 79 			if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i) { | 
| devi@23 | 80 				my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8"); | 
| devi@23 | 81 				$text = $converter->convert($text); | 
| devi@23 | 82 			} | 
| devi@23 | 83 			close(F); | 
| devi@23 | 84 			$diff{"text"}=$text; | 
| devi@23 | 85 			#print "$file loaded ($diff{day})\n"; | 
| devi@23 | 86 | 
| devi@23 | 87 			push @Diffs, \%diff; | 
| devi@23 | 88 			$i++; | 
| devi@23 | 89 		} | 
| devi@23 | 90 	} | 
| devi@23 | 91 } | 
| devi@23 | 92 | 
| devi@23 | 93 | 
| devi@23 | 94 sub bind_diff | 
| devi@23 | 95 { | 
| devi@23 | 96 #	my $path = shift; | 
| devi@23 | 97 #	my $pid = shift; | 
| devi@23 | 98 #	my $day = shift; | 
| devi@23 | 99 #	my $lab = shift; | 
| devi@23 | 100 | 
| devi@23 | 101 	print "Trying to bind diff...\n"; | 
| devi@23 | 102 | 
| devi@23 | 103 	my $cl = shift; | 
| devi@23 | 104 	my $hour = $cl->{"hour"}; | 
| devi@23 | 105 	my $min = $cl->{"min"}; | 
| devi@23 | 106 	my $sec = $cl->{"sec"}; | 
| devi@23 | 107 | 
| devi@23 | 108 	my $min_dt = 10000; | 
| devi@23 | 109 | 
| devi@23 | 110 	for my $diff (@Diffs) { | 
| devi@23 | 111 			# Check here date, time and user | 
| devi@23 | 112 			next if ($diff->{"day"} && $cl->{"day"} && ($cl->{"day"} ne $diff->{"day"})); | 
| devi@23 | 113 			#next if (!$diff->{"uid"} && $cl->{"euid"} != $diff->{"uid"}); | 
| devi@23 | 114 | 
| devi@23 | 115 			my $dt=($diff->{"hour"}-$hour)*3600 +($diff->{"min"}-$min)*60 + ($diff->{"sec"}-$sec); | 
| devi@23 | 116 			if ($dt >0  && $dt < $min_dt && ($diff->{"time_range"} <0 || $dt < $diff->{"time_range"})) { | 
| devi@23 | 117 				print "Approppriate diff found: dt=$dt\n"; | 
| devi@23 | 118 				if ($diff->{"bind_to"}) { | 
| devi@23 | 119 					undef $diff->{"bind_to"}->{"diff"}; | 
| devi@23 | 120 				}; | 
| devi@23 | 121 				$diff->{"time_range"}=$dt; | 
| devi@23 | 122 				$diff->{"bind_to"}=$cl; | 
| devi@23 | 123 | 
| devi@23 | 124 				$cl->{"diff"} = $diff->{"index"}; | 
| devi@23 | 125 				$min_dt = $dt; | 
| devi@23 | 126 			} | 
| devi@23 | 127 | 
| devi@23 | 128 	} | 
| devi@23 | 129 } | 
| devi@23 | 130 | 
| devi@23 | 131 | 
| devi@23 | 132 sub extract_from_cline | 
| devi@23 | 133 # Разобрать командную строку $_[1] и возвратить хэш, содержащий | 
| devi@23 | 134 # номер первого появление команды в строке: | 
| devi@23 | 135 # 	команда => первая позиция | 
| devi@23 | 136 { | 
| devi@23 | 137 	my $what = $_[0]; | 
| devi@23 | 138 	my $cline = $_[1]; | 
| devi@23 | 139 	my @lists = split /\;/, $cline; | 
| devi@23 | 140 | 
| devi@23 | 141 | 
| devi@23 | 142 	my @commands = (); | 
| devi@23 | 143 	for my $list (@lists) { | 
| devi@23 | 144 		push @commands, split /\|/, $list; | 
| devi@23 | 145 	} | 
| devi@23 | 146 | 
| devi@23 | 147 	my %commands; | 
| devi@23 | 148 	my %files; | 
| devi@23 | 149 	my $i=0; | 
| devi@23 | 150 	for my $command (@commands) { | 
| devi@23 | 151 		$command =~ /\s*(\S+)\s*(.*)/; | 
| devi@23 | 152 		if ($1 && $1 eq "sudo" ) { | 
| devi@23 | 153 			$commands{"$1"}=$i++; | 
| devi@23 | 154 			$command =~ s/\s*sudo\s+//; | 
| devi@23 | 155 		} | 
| devi@23 | 156 		$command =~ /\s*(\S+)\s*(.*)/; | 
| devi@23 | 157 		if ($1 && !defined $commands{"$1"}) { | 
| devi@23 | 158 				$commands{"$1"}=$i++; | 
| devi@23 | 159 		}; | 
| devi@23 | 160 		if ($2) { | 
| devi@23 | 161 			my $args = $2; | 
| devi@23 | 162 			my @args = split (/\s+/, $args); | 
| devi@23 | 163 			for my $a (@args) { | 
| devi@23 | 164 				$files{"$a"}=$i++ | 
| devi@23 | 165 					if !defined $files{"$a"}; | 
| devi@23 | 166 			}; | 
| devi@23 | 167 | 
| devi@23 | 168 | 
| devi@23 | 169 		} | 
| devi@23 | 170 	} | 
| devi@23 | 171 | 
| devi@23 | 172 	if ($what eq "commands") { | 
| devi@23 | 173 		return %commands; | 
| devi@23 | 174 	} else { | 
| devi@23 | 175 		return %files; | 
| devi@23 | 176 	} | 
| devi@23 | 177 | 
| devi@23 | 178 } | 
| devi@23 | 179 | 
| devi@23 | 180 sub load_command_lines | 
| devi@23 | 181 { | 
| devi@23 | 182 	my $lab_scripts_path = $_[0]; | 
| devi@23 | 183 	my $lab_scripts_mask = $_[1]; | 
| devi@23 | 184 | 
| devi@23 | 185 	my $cline_re_base = qq' | 
| devi@23 | 186 			(?:\\^?([0-9]*C?))					# exitcode | 
| devi@23 | 187 			(?:_([0-9]+)_)?				# uid | 
| devi@23 | 188 			(?:_([0-9]+)_)				# pid | 
| devi@23 | 189 			(...?)					# day | 
| devi@23 | 190 			(.?.?)					# lab | 
| devi@23 | 191 			\\s					# space separator | 
| devi@23 | 192 			([0-9][0-9]):([0-9][0-9]):([0-9][0-9])	# time | 
| devi@23 | 193 			.\\[50D.\\[K				# killing symbols | 
| devi@23 | 194 			(.*?([\$\#]\\s?))			# prompt | 
| devi@23 | 195 			(.*)					# command line | 
| devi@23 | 196 			'; | 
| devi@23 | 197 	#my $cline_re = qr/$cline_re_base(?:$cline_re_base|$)/x; | 
| devi@23 | 198 	#my $cline_re = qr/(?:$cline_re_base)*$cline_re_base$/x; | 
| devi@23 | 199 	my $cline_re = qr/$cline_re_base/sx; | 
| devi@23 | 200 	my $cline_re1 = qr/$cline_re_base\x0D/sx; | 
| devi@23 | 201 	my $cline_re2 = qr/$cline_re_base$/sx; | 
| devi@23 | 202 | 
| devi@23 | 203 	my $vt = Term::VT102->new (	'cols' => $Config{"terminal_width"}, | 
| devi@23 | 204 					'rows' => $Config{"terminal_height"}); | 
| devi@23 | 205 	my $cline_vt = Term::VT102->new ('cols' => $Config{"terminal_width"}, | 
| devi@23 | 206 					'rows' => $Config{"terminal_height"}); | 
| devi@23 | 207 | 
| devi@23 | 208 	my $converter = Text::Iconv->new($Config{"encoding"}, "utf-8") | 
| devi@23 | 209 		if ($Config{"encoding"} && $Config{"encoding"} !~ /^utf-8$/i); | 
| devi@23 | 210 | 
| devi@23 | 211 	print "Loading lm-scripts...\n" if $Config{"verbose"} =~ /y/; | 
| devi@23 | 212 | 
| devi@23 | 213 	my @lab_scripts = <$lab_scripts_path/$lab_scripts_mask>; | 
| devi@23 | 214 	my $file; | 
| devi@23 | 215 	my $files_number = $#lab_scripts; | 
| devi@23 | 216 	my $ii = 0; | 
| devi@23 | 217 	my $skip_info; | 
| devi@23 | 218 | 
| devi@23 | 219 	my $commandlines_loaded =0; | 
| devi@23 | 220 	my $commandlines_processed =0; | 
| devi@23 | 221 | 
| devi@23 | 222 	for $file (@lab_scripts){ | 
| devi@23 | 223 		#printf "\t%i %3.2f\n", $ii, (100*$ii++/$files_number) if $Config{"verbose"} =~ /y/; | 
| devi@23 | 224 | 
| devi@23 | 225 		open (FILE, "$file"); | 
| devi@23 | 226 		binmode FILE; | 
| devi@23 | 227 		$file =~ m@.*/(.*?)-.*@; | 
| devi@23 | 228 | 
| devi@23 | 229 		my $tty = $1; | 
| devi@23 | 230 		my $first_pass = 1; | 
| devi@23 | 231 		my %cl; | 
| devi@23 | 232 		my $last_output_length=0; | 
| devi@23 | 233 		while (<FILE>) { | 
| devi@23 | 234 			$commandlines_processed++; | 
| devi@23 | 235 				# time | 
| devi@23 | 236 | 
| devi@23 | 237 			if (/[0-9][0-9]:[0-9][0-9]:[0-9][0-9].\[[0-9][0-9]D.\[K/ && m/$cline_re/) { | 
| devi@23 | 238 				s/.*\x0d(?!\x0a)//; | 
| devi@23 | 239 		#		print "!!!",$_,"!!!\n"; | 
| devi@23 | 240 			#	next; | 
| devi@23 | 241 			#	while (m/$cline_re1/gs) { | 
| devi@23 | 242 			#	} | 
| devi@23 | 243 				m/$cline_re2/gs; | 
| devi@23 | 244 | 
| devi@23 | 245 				$commandlines_loaded++; | 
| devi@23 | 246 				$last_output_length=0; | 
| devi@23 | 247 | 
| devi@23 | 248 				# Previous command | 
| devi@23 | 249 				my %last_cl = %cl; | 
| devi@23 | 250 				my $err = $1 || ""; | 
| devi@23 | 251 | 
| devi@23 | 252 | 
| devi@23 | 253 =cut | 
| devi@23 | 254 | 
| devi@23 | 255 ТАБЛИЦА КОМАНД | 
| devi@23 | 256 | 
| devi@23 | 257 	uid | 
| devi@23 | 258 		Идентификатор пользователя | 
| devi@23 | 259 | 
| devi@23 | 260 	tty | 
| devi@23 | 261 		Идентификатор терминала, на котором была вызвана команда | 
| devi@23 | 262 | 
| devi@23 | 263 	pid | 
| devi@23 | 264 		PID-процесса командного интерпретатора, | 
| devi@23 | 265 		в котором была вызвана команда | 
| devi@23 | 266 | 
| devi@23 | 267 	lab | 
| devi@23 | 268 		лабораторная работа, к которой относится команда. | 
| devi@23 | 269 		Идентификатор текущей лабораторной работы | 
| devi@23 | 270 		хранится в файле ~/.labmaker/lab | 
| devi@23 | 271 | 
| devi@23 | 272 	pwd (!) | 
| devi@23 | 273 		текущий каталог, из которого была вызвана команда | 
| devi@23 | 274 | 
| devi@23 | 275 	day | 
| devi@23 | 276 		время вызова, день | 
| devi@23 | 277 		В действительности здесь хранится не время вызова команды, | 
| devi@23 | 278 		а с момента появления приглашения командного интерпретатора | 
| devi@23 | 279 		для ввода команды | 
| devi@23 | 280 | 
| devi@23 | 281 | 
| devi@23 | 282 	hour | 
| devi@23 | 283 		время вызова, час | 
| devi@23 | 284 | 
| devi@23 | 285 	min | 
| devi@23 | 286 		время вызова, минута | 
| devi@23 | 287 | 
| devi@23 | 288 	sec | 
| devi@23 | 289 		время вызова, секунда | 
| devi@23 | 290 | 
| devi@23 | 291 	time (!) | 
| devi@23 | 292 		время вызова команды в Unix-формате. | 
| devi@23 | 293 		Предпочтительнее использовать этот формат чем hour:min:sec, | 
| devi@23 | 294 		использовавшийся в Labmaker | 
| devi@23 | 295 | 
| devi@23 | 296 	fullprompt | 
| devi@23 | 297 		Приглашение командной строки | 
| devi@23 | 298 | 
| devi@23 | 299 	prompt | 
| devi@23 | 300 		Сокращённое приглашение командной строки | 
| devi@23 | 301 | 
| devi@23 | 302 	cline | 
| devi@23 | 303 		Командная строка | 
| devi@23 | 304 | 
| devi@23 | 305 	output | 
| devi@23 | 306 		Результат выполнения команды | 
| devi@23 | 307 | 
| devi@23 | 308 	diff | 
| devi@23 | 309 		Указатель на ассоциированный с командой diff | 
| devi@23 | 310 | 
| devi@23 | 311 	note (!) | 
| devi@23 | 312 		Текстовый комментарий к команде. | 
| devi@23 | 313 		Может генерироваться из самого лога с помощью команд | 
| devi@23 | 314 			#^ Комментарий | 
| devi@23 | 315 			#v Комментарий | 
| devi@23 | 316 		в том случае, если для комментирования достаточно одной строки, | 
| devi@23 | 317 		или с помощью команд | 
| devi@23 | 318 			cat > /dev/null #^ Заголовок | 
| devi@23 | 319 			Текст | 
| devi@23 | 320 			^D | 
| devi@23 | 321 		в том случае, если комментарий развёрнутый. | 
| devi@23 | 322 		В последнем случае комментарий может содержать | 
| devi@23 | 323 		заголовок, абзацы и несложное форматирование. | 
| devi@23 | 324 | 
| devi@23 | 325 		Символ ^ или v после знака комментария # обозначает, | 
| devi@23 | 326 		к какой команде относится комментарий: | 
| devi@23 | 327 		к предыдущей (^) или последующей (v) | 
| devi@23 | 328 | 
| devi@23 | 329 	err | 
| devi@23 | 330 		Код завершения командной строки | 
| devi@23 | 331 | 
| devi@23 | 332 	histnum (!) | 
| devi@23 | 333 		Номер команды в истории командного интерпретатора | 
| devi@23 | 334 | 
| devi@23 | 335 	status (!) | 
| devi@23 | 336 		Является ли данная команда вызванной (r), запомненной (s) | 
| devi@23 | 337 		или это подсказка completion (c). | 
| devi@23 | 338 | 
| devi@23 | 339 		Команды, которые были вызваны и обработаны интерпретатором | 
| devi@23 | 340 		имеют состояние "r". К таким командам относится большинство | 
| devi@23 | 341 		команд вводимых в интерпретатор. | 
| devi@23 | 342 | 
| devi@23 | 343 		Если команда набрана, но вызывать её по какой-либо причине | 
| devi@23 | 344 		не хочется (например, команда может быть не полной, вредоносной | 
| devi@23 | 345 		или просто бессмысленной в текущих условиях), | 
| devi@23 | 346 		её можно сбросить с помощью комбинации клавиш Ctrl-C | 
| devi@23 | 347 		(не путайте с прерыванием работающей команды! здесь она даже | 
| devi@23 | 348 		не запускается!). | 
| devi@23 | 349 		В таком случае она не выполняется, но попадает в журнал | 
| devi@23 | 350 		со статусом "s". | 
| devi@23 | 351 | 
| devi@23 | 352 		Если команда появилась в журнале благодаря автопроолжению | 
| devi@23 | 353 		-- когда было показано несколько вариантов -- | 
| devi@23 | 354 		она имеет статус "c". | 
| devi@23 | 355 | 
| devi@23 | 356 	euid | 
| devi@23 | 357 		Идентификатор пользователя от имени которого будет | 
| devi@23 | 358 		выполняться команда. | 
| devi@23 | 359 		Может отличаться от реального uid в том случае, | 
| devi@23 | 360 		если вызывается с помощью sudo | 
| devi@23 | 361 | 
| devi@23 | 362 | 
| devi@23 | 363 	version (!) | 
| devi@23 | 364 		Версия lilalo-prompt использовавшаяся при записи | 
| devi@23 | 365 		команды. | 
| devi@23 | 366 | 
| devi@23 | 367 		0 - версия использовавшая в labmaker. | 
| devi@23 | 368 			Отсутствует информация о текущем каталоге и номере в истории. | 
| devi@23 | 369 			Информация о версии также не указана в приглашении. | 
| devi@23 | 370 | 
| devi@23 | 371 | 
| devi@23 | 372 		1 - версия использующаяся в lilalo | 
| devi@23 | 373 | 
| devi@23 | 374 	raw_file (*) | 
| devi@23 | 375 		Имя файла, в котором находится бинарное представление журнала. | 
| devi@23 | 376 		Может содержать ключевое слово HERE, | 
| devi@23 | 377 		обозначающее что бинарное представление хранится | 
| devi@23 | 378 		непосредственно в базе данных в атрибуте raw_data | 
| devi@23 | 379 | 
| devi@23 | 380 	raw_start (*) | 
| devi@23 | 381 		Начало блока командной строки в файле бинарного представления | 
| devi@23 | 382 | 
| devi@23 | 383 	raw_end (*) | 
| devi@23 | 384 		Конец блока командной строки в файле бинарного представления | 
| devi@23 | 385 | 
| devi@23 | 386 	raw_cline (*) | 
| devi@23 | 387 		Необработанная командная строка в бинарном виде | 
| devi@23 | 388 | 
| devi@23 | 389 	raw_data (*) | 
| devi@23 | 390 		Бинарное представление команды и результатов её выполнения | 
| devi@23 | 391 | 
| devi@23 | 392 | 
| devi@23 | 393 | 
| devi@23 | 394 | 
| devi@23 | 395 ТАБЛИЦА SESSION | 
| devi@23 | 396 | 
| devi@23 | 397 	Информация о сеансах | 
| devi@23 | 398 | 
| devi@23 | 399 | 
| devi@23 | 400 | 
| devi@23 | 401 | 
| devi@23 | 402 =cut | 
| devi@23 | 403 | 
| devi@23 | 404 				# Parse new command | 
| devi@23 | 405 				$cl{"uid"} = $2; | 
| devi@23 | 406 				$cl{"euid"} = $cl{"uid"};	# Если в команде обнаружится sudo, euid поменяем на 0 | 
| devi@23 | 407 				$cl{"pid"} = $3; | 
| devi@23 | 408 				$cl{"day"} = $4; | 
| devi@23 | 409 				$cl{"lab"} = $5; | 
| devi@23 | 410 				$cl{"hour"} = $6; | 
| devi@23 | 411 				$cl{"min"} = $7; | 
| devi@23 | 412 				$cl{"sec"} = $8; | 
| devi@23 | 413 				$cl{"fullprompt"} = $9; | 
| devi@23 | 414 				$cl{"prompt"} = $10; | 
| devi@23 | 415 				$cl{"raw_cline"} = $11; | 
| devi@23 | 416 | 
| devi@23 | 417 				$cl{"err"} = 0; | 
| devi@23 | 418 				$cl{"output"} = ""; | 
| devi@23 | 419 				$cl{"tty"} = $tty; | 
| devi@23 | 420 | 
| devi@23 | 421 				$cline_vt->process($cl{"raw_cline"}."\n"); | 
| devi@23 | 422 				$cl{"cline"} = $cline_vt->row_plaintext (1); | 
| devi@23 | 423 				$cl{"cline"} =~ s/\s*$//; | 
| devi@23 | 424 				$cline_vt->reset(); | 
| devi@23 | 425 | 
| devi@23 | 426 				my %commands = extract_from_cline("commands", $cl{"cline"}); | 
| devi@23 | 427 				$cl{"euid"}=0 if defined $commands{"sudo"}; | 
| devi@23 | 428 				my @comms = sort { $commands{$a} cmp $commands{$b} } keys %commands; | 
| devi@23 | 429 				$cl{"last_command"} = $comms[$#comms] || ""; | 
| devi@23 | 430 | 
| devi@23 | 431 				if ( | 
| devi@23 | 432 				$Config{"suppress_editors"} =~ /^y/i | 
| devi@23 | 433 					&& grep ($_ eq $cl{"last_command"}, @{$Config{"editors"}}) || | 
| devi@23 | 434 				$Config{"suppress_pagers"}  =~ /^y/i | 
| devi@23 | 435 					&& grep ($_ eq $cl{"last_command"}, @{$Config{"pagers"}}) || | 
| devi@23 | 436 				$Config{"suppress_terminal"}=~ /^y/i | 
| devi@23 | 437 					&& grep ($_ eq $cl{"last_command"}, @{$Config{"terminal"}}) | 
| devi@23 | 438 				) { | 
| devi@23 | 439 					$cl{"suppress_output"} = "1"; | 
| devi@23 | 440 				} | 
| devi@23 | 441 				else { | 
| devi@23 | 442 					$cl{"suppress_output"} = "0"; | 
| devi@23 | 443 | 
| devi@23 | 444 				} | 
| devi@23 | 445 				$skip_info = 0; | 
| devi@23 | 446 | 
| devi@23 | 447 | 
| devi@23 | 448 				print " ",$cl{"last_command"}; | 
| devi@23 | 449 | 
| devi@23 | 450 				# Processing previous command line | 
| devi@23 | 451 				if ($first_pass) { | 
| devi@23 | 452 					$first_pass = 0; | 
| devi@23 | 453 					next; | 
| devi@23 | 454 				} | 
| devi@23 | 455 | 
| devi@23 | 456 				# Error code | 
| devi@23 | 457 				$last_cl{"err"}=$err; | 
| devi@23 | 458 				$last_cl{"err"}=130 if $err eq "^C"; | 
| devi@23 | 459 | 
| devi@23 | 460 				if (grep ($_ eq $last_cl{"last_command"}, @{$Config{"editors"}})) { | 
| devi@23 | 461 					bind_diff(\%last_cl); | 
| devi@23 | 462 				} | 
| devi@23 | 463 | 
| devi@23 | 464 				# Output | 
| devi@23 | 465 				if (!$last_cl{"suppress_output"} || $last_cl{"err"}) { | 
| devi@23 | 466 					for (my $i=0; $i<$Config{"terminal_height"}; $i++) { | 
| devi@23 | 467 						my $line= $vt->row_plaintext($i); | 
| devi@23 | 468 						next if !defined ($line) || $line =~ /^\s*$/; | 
| devi@23 | 469 						$line =~ s/\s*$//; | 
| devi@23 | 470 						$last_cl{"output"} .= $line."\n"; | 
| devi@23 | 471 					} | 
| devi@23 | 472 				} | 
| devi@23 | 473 				else { | 
| devi@23 | 474 					$last_cl{"output"}= ""; | 
| devi@23 | 475 				} | 
| devi@23 | 476 | 
| devi@23 | 477 				$vt->reset(); | 
| devi@23 | 478 | 
| devi@23 | 479 | 
| devi@23 | 480 				# Classifying the command line | 
| devi@23 | 481 | 
| devi@23 | 482 | 
| devi@23 | 483 				# Save | 
| devi@23 | 484 				if (!$Config{"lab"} || $cl{"lab"} eq $Config{"lab"}) { | 
| devi@23 | 485 					# Changing encoding | 
| devi@23 | 486 					for (keys %last_cl) { | 
| devi@23 | 487 						$last_cl{$_} = $converter->convert($last_cl{$_}) | 
| devi@23 | 488 							if ($Config{"encoding"} && | 
| devi@23 | 489 							$Config{"encoding"} !~ /^utf-8$/i); | 
| devi@23 | 490 					} | 
| devi@23 | 491 					push @Command_Lines, \%last_cl; | 
| devi@23 | 492 				} | 
| devi@23 | 493 				next; | 
| devi@23 | 494 			} | 
| devi@23 | 495 			$last_output_length+=length($_); | 
| devi@23 | 496 			#if (!$cl{"suppress_output"} || $last_output_length < 5000) { | 
| devi@23 | 497 			if ($last_output_length < 50000) { | 
| devi@23 | 498 				#print "(",length($_),")" if (length($_) > 2000) ; | 
| devi@23 | 499 				$vt->process("$_"."\n") | 
| devi@23 | 500 			} | 
| devi@23 | 501 			else | 
| devi@23 | 502 			{ | 
| devi@23 | 503 				if (!$skip_info) { | 
| devi@23 | 504 					print "($cl{last_command})"; | 
| devi@23 | 505 					$skip_info = 1; | 
| devi@23 | 506 				} | 
| devi@23 | 507 			} | 
| devi@23 | 508 		} | 
| devi@23 | 509 		close(FILE); | 
| devi@23 | 510 | 
| devi@23 | 511 	} | 
| devi@23 | 512 	if ($Config{"verbose"} =~ /y/) { | 
| devi@23 | 513 		print "...finished." ; | 
| devi@23 | 514 		print "Lines loaded: $commandlines_processed\n"; | 
| devi@23 | 515 		print "Command lines: $commandlines_loaded\n"; | 
| devi@23 | 516 	} | 
| devi@23 | 517 } | 
| devi@23 | 518 | 
| devi@23 | 519 | 
| devi@23 | 520 | 
| devi@23 | 521 sub printq | 
| devi@23 | 522 { | 
| devi@23 | 523 	my $TO = shift; | 
| devi@23 | 524 	my $text = join "", @_; | 
| devi@23 | 525 	$text =~ s/&/&/g; | 
| devi@23 | 526 	$text =~ s/</</g; | 
| devi@23 | 527 	$text =~ s/>/>/g; | 
| devi@23 | 528 	print $TO $text; | 
| devi@23 | 529 } | 
| devi@23 | 530 | 
| devi@23 | 531 | 
| devi@23 | 532 sub sort_command_lines | 
| devi@23 | 533 { | 
| devi@23 | 534 	print "Sorting command lines...\n" if $Config{"verbose"} =~ /y/; | 
| devi@23 | 535 | 
| devi@23 | 536 	# Sort Command_Lines | 
| devi@23 | 537 	# Write Command_Lines to Command_Lines_Index | 
| devi@23 | 538 | 
| devi@23 | 539 	my @index; | 
| devi@23 | 540 	for (my $i=0;$i<=$#Command_Lines;$i++) { | 
| devi@23 | 541 		$index[$i]=$i; | 
| devi@23 | 542 	} | 
| devi@23 | 543 | 
| devi@23 | 544 	@Command_Lines_Index = sort { | 
| devi@23 | 545 		$Command_Lines[$index[$a]]->{"day"} cmp $Command_Lines[$index[$b]]->{"day"} || | 
| devi@23 | 546 		$Command_Lines[$index[$a]]->{"hour"} <=> $Command_Lines[$index[$b]]->{"hour"} || | 
| devi@23 | 547 		$Command_Lines[$index[$a]]->{"min"} <=> $Command_Lines[$index[$b]]->{"min"} || | 
| devi@23 | 548 		$Command_Lines[$index[$a]]->{"sec"} <=> $Command_Lines[$index[$b]]->{"sec"} | 
| devi@23 | 549 	} @index; | 
| devi@23 | 550 | 
| devi@23 | 551 	print "...finished\n" if $Config{"verbose"} =~ /y/; | 
| devi@23 | 552 | 
| devi@23 | 553 } | 
| devi@23 | 554 | 
| devi@23 | 555 sub process_command_lines | 
| devi@23 | 556 { | 
| devi@23 | 557 	for my $i (@Command_Lines_Index) { | 
| devi@23 | 558 | 
| devi@23 | 559 		my $cl = \$Command_Lines[$i]; | 
| devi@23 | 560 		@{${$cl}->{"new_commands"}} =(); | 
| devi@23 | 561 		@{${$cl}->{"new_files"}} =(); | 
| devi@23 | 562 		$$cl->{"class"} = ""; | 
| devi@23 | 563 | 
| devi@23 | 564 		if ($$cl->{"err"}) { | 
| devi@23 | 565 			$$cl->{"class"}="wrong"; | 
| devi@23 | 566 			$$cl->{"class"}="interrupted" | 
| devi@23 | 567 				if ($$cl->{"err"} eq 130); | 
| devi@23 | 568 		} | 
| devi@23 | 569 		if (!$$cl->{"euid"}) { | 
| devi@23 | 570 			$$cl->{"class"}.="_root"; | 
| devi@23 | 571 		} | 
| devi@23 | 572 | 
| devi@23 | 573 #tab#		my @tab_words=split /\s+/, $$cl->{"output"}; | 
| devi@23 | 574 #tab#		my $last_word= $$cl->{"cline"} =~ /(\S*)$/; | 
| devi@23 | 575 #tab#		$last_word =~ s@.*/@@; | 
| devi@23 | 576 #tab#		my $this_is_tab=1; | 
| devi@23 | 577 #tab# | 
| devi@23 | 578 #tab#		if ($last_word && @tab_words >2) { | 
| devi@23 | 579 #tab#			for my $tab_words (@tab_words) { | 
| devi@23 | 580 #tab#				if ($tab_words !~ /^$last_word/) { | 
| devi@23 | 581 #tab#					$this_is_tab=0; | 
| devi@23 | 582 #tab#					last; | 
| devi@23 | 583 #tab#				} | 
| devi@23 | 584 #tab#			} | 
| devi@23 | 585 #tab#		} | 
| devi@23 | 586 #tab#		$$cl->{"class"}="tab" if $this_is_tab; | 
| devi@23 | 587 | 
| devi@23 | 588 | 
| devi@23 | 589 		if ( !$$cl->{"err"}) { | 
| devi@23 | 590 			# Command does not contain mistakes | 
| devi@23 | 591 | 
| devi@23 | 592 			my %commands = extract_from_cline("commands", ${$cl}->{"cline"}); | 
| devi@23 | 593 			my %files = extract_from_cline("files", ${$cl}->{"cline"}); | 
| devi@23 | 594 | 
| devi@23 | 595 			# Searching for new commands only | 
| devi@23 | 596 			for my $command (keys  %commands) { | 
| devi@23 | 597 				if (!defined $Commands_Stat{$command}) { | 
| devi@23 | 598 					push @{$$cl->{new_commands}}, $command; | 
| devi@23 | 599 				} | 
| devi@23 | 600 				$Commands_Stat{$command}++; | 
| devi@23 | 601 			} | 
| devi@23 | 602 | 
| devi@23 | 603 			for my $file (keys  %files) { | 
| devi@23 | 604 				if (!defined $Files_Stat{$file}) { | 
| devi@23 | 605 					push @{$$cl->{new_files}}, $file; | 
| devi@23 | 606 				} | 
| devi@23 | 607 				$Files_Stat{$file}++; | 
| devi@23 | 608 			} | 
| devi@23 | 609 		} | 
| devi@23 | 610 	} | 
| devi@23 | 611 | 
| devi@23 | 612 } | 
| devi@23 | 613 | 
| devi@23 | 614 | 
| devi@23 | 615 =cut | 
| devi@23 | 616 Вывести результат обработки журнала. | 
| devi@23 | 617 =cut | 
| devi@23 | 618 | 
| devi@23 | 619 | 
| devi@23 | 620 sub print_command_lines | 
| devi@23 | 621 { | 
| devi@23 | 622 	my $output_filename=$_[0]; | 
| devi@23 | 623 	open(OUT, ">", $output_filename) | 
| devi@23 | 624 		or die "Can't open $output_filename for writing\n"; | 
| devi@23 | 625 | 
| devi@23 | 626 | 
| devi@23 | 627 | 
| devi@23 | 628 	print OUT "<livelablog>\n"; | 
| devi@23 | 629 | 
| devi@23 | 630 	my $cl; | 
| devi@23 | 631 	my $in_range=0; | 
| devi@23 | 632 	for my $i (@Command_Lines_Index) { | 
| devi@23 | 633 		$cl = $Command_Lines[$i]; | 
| devi@23 | 634 | 
| devi@23 | 635 		if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) { | 
| devi@23 | 636 			$in_range=1; | 
| devi@23 | 637 			next; | 
| devi@23 | 638 		} | 
| devi@23 | 639 		if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) { | 
| devi@23 | 640 			$in_range=0; | 
| devi@23 | 641 			next; | 
| devi@23 | 642 		} | 
| devi@23 | 643 		next if ($Config{"from"} && $Config{"to"} && !$in_range) | 
| devi@23 | 644 			|| | 
| devi@23 | 645 		    	($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ ) | 
| devi@23 | 646 			|| | 
| devi@23 | 647 			($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0) | 
| devi@23 | 648 			|| | 
| devi@23 | 649 			($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130); | 
| devi@23 | 650 | 
| devi@23 | 651 		my @new_commands=@{$cl->{"new_commands"}}; | 
| devi@23 | 652 		my @new_files=@{$cl->{"new_files"}}; | 
| devi@23 | 653 | 
| devi@23 | 654 		my $cl_class="cline"; | 
| devi@23 | 655 		my $out_class="output"; | 
| devi@23 | 656 		if ($cl->{"class"}) { | 
| devi@23 | 657 			$cl_class = $cl->{"class"}."_".$cl_class; | 
| devi@23 | 658 			$out_class = $cl->{"class"}."_".$out_class; | 
| devi@23 | 659 		} | 
| devi@23 | 660 | 
| devi@23 | 661 		# Вырезаем из вывода только нужное количество строк | 
| devi@23 | 662 | 
| devi@23 | 663 		my $output=""; | 
| devi@23 | 664 		if ($Config{"head_lines"} || $Config{"tail_lines"}) { | 
| devi@23 | 665 			# Partialy output | 
| devi@23 | 666 			my @lines = split '\n', $cl->{"output"}; | 
| devi@23 | 667 			# head | 
| devi@23 | 668 			my $mark=1; | 
| devi@23 | 669 			for (my $i=0; $i<= $#lines && $i < $Config{"cache_head_lines"}; $i++) { | 
| devi@23 | 670 				$output .= $lines[$i]."\n"; | 
| devi@23 | 671 			} | 
| devi@23 | 672 			# tail | 
| devi@23 | 673 			my $start=$#lines-$Config{"cache_tail_lines"}+1; | 
| devi@23 | 674 			if ($start < 0) { | 
| devi@23 | 675 				$start=0; | 
| devi@23 | 676 				$mark=0; | 
| devi@23 | 677 			} | 
| devi@23 | 678 			if ($start < $Config{"cache_head_lines"}) { | 
| devi@23 | 679 				$start=$Config{"cache_head_lines"}; | 
| devi@23 | 680 				$mark=0; | 
| devi@23 | 681 			} | 
| devi@23 | 682 			$output .= $Config{"skip_text"}."\n" if $mark; | 
| devi@23 | 683 			for (my $i=$start; $i<= $#lines; $i++) { | 
| devi@23 | 684 				$output .= $lines[$i]."\n"; | 
| devi@23 | 685 			} | 
| devi@23 | 686 		} | 
| devi@23 | 687 		else { | 
| devi@23 | 688 			# Full output | 
| devi@23 | 689 			$output .= $cl->{"output"}; | 
| devi@23 | 690 		} | 
| devi@23 | 691 		$output .= "^C\n" if ($cl->{"err"} eq "130"); | 
| devi@23 | 692 | 
| devi@23 | 693 | 
| devi@23 | 694 		# Совместимость с labmaker | 
| devi@23 | 695 | 
| devi@23 | 696 		# Переводим в секунды Эпохи | 
| devi@23 | 697 		# В labmaker'е данные хранились в неудобной форме: hour, min, sec, day of year | 
| devi@23 | 698 		# Информация о годе отсутствовала | 
| devi@23 | 699 		# Её можно внести: | 
| devi@23 | 700 		# Декабрь 2004 год; остальные -- 2005 год. | 
| devi@23 | 701 | 
| devi@23 | 702 		my $year = 2005; | 
| devi@23 | 703 		$year = 2004 if ( $cl->{day} > 330 ); | 
| devi@23 | 704 		# timelocal(			$sec,	   $min,      $hour,      $mday,$mon,$year); | 
| devi@23 | 705 		$cl->{time} = timelocal_nocheck($cl->{sec},$cl->{min},$cl->{hour},$cl->{day},0,$year); | 
| devi@23 | 706 | 
| devi@23 | 707 | 
| devi@23 | 708 		# Начинаем вывод команды | 
| devi@23 | 709 		print OUT "<command>\n"; | 
| devi@23 | 710 		print OUT "<time>",$cl->{time},"</time>\n"; | 
| devi@23 | 711 		print OUT "<tty>",$cl->{tty},"</tty>\n"; | 
| devi@23 | 712 		print OUT "<out_class>",$out_class,"</out_class>\n"; | 
| devi@23 | 713 		print OUT "<prompt>"; | 
| devi@23 | 714 			printq(\*OUT,,$cl->{"prompt"}); | 
| devi@23 | 715 		print OUT "</prompt>"; | 
| devi@23 | 716 		print OUT "<cline>"; | 
| devi@23 | 717 			printq(\*OUT,$cl->{"cline"}); | 
| devi@23 | 718 		print OUT "</cline>\n"; | 
| devi@23 | 719 		print OUT "<last_command>",$cl->{"last_command"},"</last_command>\n"; | 
| devi@23 | 720 		if (@new_commands) { | 
| devi@23 | 721 			print OUT "<new_commands>"; | 
| devi@23 | 722 			printq(\*OUT, join (" ", @new_commands)); | 
| devi@23 | 723 			print OUT "</new_commands>"; | 
| devi@23 | 724 		} | 
| devi@23 | 725 		if (@new_files) { | 
| devi@23 | 726 			print OUT "<new_files>"; | 
| devi@23 | 727 			printq(\*OUT, join (" ", @new_files)); | 
| devi@23 | 728 			print OUT "</new_files>"; | 
| devi@23 | 729 		} | 
| devi@23 | 730 		print OUT "<output>"; | 
| devi@23 | 731 			printq(\*OUT,$output); | 
| devi@23 | 732 		print OUT "</output>\n"; | 
| devi@23 | 733 		if ($cl->{"diff"}) { | 
| devi@23 | 734 			print OUT "<diff>"; | 
| devi@23 | 735 				printq(\*OUT,${$Diffs[$cl->{"diff"}]}{"text"}); | 
| devi@23 | 736 			print OUT "</diff>\n"; | 
| devi@23 | 737 		} | 
| devi@23 | 738 		print OUT "</command>\n"; | 
| devi@23 | 739 | 
| devi@23 | 740 	} | 
| devi@23 | 741 | 
| devi@23 | 742 	print OUT "</livelablog>\n"; | 
| devi@23 | 743 	close(OUT); | 
| devi@23 | 744 } | 
| devi@23 | 745 | 
| devi@23 | 746 | 
| devi@23 | 747 =cut | 
| devi@23 | 748 sub print_command_lines2 | 
| devi@23 | 749 { | 
| devi@23 | 750 	my $output_filename=$_[0]; | 
| devi@23 | 751 	open(OUT, ">", $output_filename) | 
| devi@23 | 752 		or die "Can't open $output_filename for writing\n"; | 
| devi@23 | 753 | 
| devi@23 | 754 | 
| devi@23 | 755 	print OUT <<OUT; | 
| devi@23 | 756 <log> | 
| devi@23 | 757 OUT | 
| devi@23 | 758 | 
| devi@23 | 759 	my $cl; | 
| devi@23 | 760 	for my $i (@Command_Lines_Index) { | 
| devi@23 | 761 | 
| devi@23 | 762 | 
| devi@23 | 763 		$cl = $Command_Lines[$i]; | 
| devi@23 | 764 | 
| devi@23 | 765 | 
| devi@23 | 766 # Printing out | 
| devi@23 | 767 		print OUT <<OUT; | 
| devi@23 | 768 	<command> | 
| devi@23 | 769 		<day>$cl->{day}</day> | 
| devi@23 | 770 		<hour>$cl->{hour}</hour> | 
| devi@23 | 771 		<min>$cl->{min}</min> | 
| devi@23 | 772 		<sec>$cl->{sec}</sec> | 
| devi@23 | 773 		<tty>$cl->{tty}</tty> | 
| devi@23 | 774 		<uid>$cl->{uid}</uid> | 
| devi@23 | 775 		<euid>$cl->{euid}</euid> | 
| devi@23 | 776 		<prompt>$cl->{prompt}</prompt> | 
| devi@23 | 777 		<cline>$cl->{cline}</cline> | 
| devi@23 | 778 		<status>$cl->{err}</cline> | 
| devi@23 | 779 		<output> | 
| devi@23 | 780 $cl->{output}</output> | 
| devi@23 | 781 	</command> | 
| devi@23 | 782 OUT | 
| devi@23 | 783 	} | 
| devi@23 | 784 | 
| devi@23 | 785 	for my $diff (@Diffs) { | 
| devi@23 | 786 | 
| devi@23 | 787 		print OUT <<OUT; | 
| devi@23 | 788 	<diff> | 
| devi@23 | 789 		<path>$diff->{path}</path> | 
| devi@23 | 790 		<uid>$diff->{uid}</uid> | 
| devi@23 | 791 		<day>$diff->{day}</day> | 
| devi@23 | 792 		<hour>$diff->{hour}</hour> | 
| devi@23 | 793 		<min>$diff->{min}</min> | 
| devi@23 | 794 		<sec>$diff->{sec}</sec> | 
| devi@23 | 795 		<text> | 
| devi@23 | 796 $diff->{text}</text> | 
| devi@23 | 797 	</diff> | 
| devi@23 | 798 OUT | 
| devi@23 | 799 	} | 
| devi@23 | 800 | 
| devi@23 | 801 	print OUT <<OUT; | 
| devi@23 | 802 </log> | 
| devi@23 | 803 OUT | 
| devi@23 | 804 } | 
| devi@23 | 805 =cut | 
| devi@23 | 806 | 
| devi@23 | 807 main(); | 
| devi@23 | 808 | 
| devi@23 | 809 sub main | 
| devi@23 | 810 { | 
| devi@23 | 811 $| = 1; | 
| devi@23 | 812 | 
| devi@23 | 813 init_variables(); | 
| devi@23 | 814 init_config(); | 
| devi@23 | 815 | 
| devi@23 | 816 for my $lab_log (split (/\s+/, $Config{"diffs"} || $Config{"input"})) { | 
| devi@23 | 817 	load_diff_files($lab_log); | 
| devi@23 | 818 } | 
| devi@23 | 819 | 
| devi@23 | 820 load_command_lines($Config{"input"}, $Config{"input_mask"}); | 
| devi@23 | 821 sort_command_lines; | 
| devi@23 | 822 process_command_lines; | 
| devi@23 | 823 print_command_lines($Config{"cache"}); | 
| devi@23 | 824 | 
| devi@23 | 825 } | 
| devi@23 | 826 | 
| devi@23 | 827 sub init_variables | 
| devi@23 | 828 { | 
| devi@23 | 829 } |