"Fossies" - the Fresh Open Source Software Archive 
Member "ApaLogFilter-0.99.010/ApaLogFilter.pl" (7 Sep 2006, 38350 Bytes) of package /linux/www/old/ApaLogFilter-0.99.010.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
1 #!/usr/bin/perl -w
2 ###############################################################################
3 ## ##
4 ## A P A L O G F I L T E R . P L ##
5 ## ##
6 ## ------------------------------------------------------------------------- ##
7 ## ##
8 ## Job .......: Script to filter and transform an existing apache-logfile. ##
9 ## ##
10 ## ------------------------------------------------------------------------- ##
11 ## ##
12 ## Copyright (C) 2000 Daniel Scheibli ##
13 ## ##
14 ## This program is free software; you can redistribute it and/or modify it ##
15 ## under the terms of the GNU General Public License as published by the ##
16 ## Free Software Foundation; either version 2 of the License, or (at your ##
17 ## option) any later version. ##
18 ## ##
19 ## This program is distributed in the hope that it will be useful, but ##
20 ## WITHOUT ANY WARRANTY; without even the implied warranty of ##
21 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ##
22 ## GNU General Public License for more details. ##
23 ## ##
24 ## You should have received a copy of the GNU General Public License along ##
25 ## with this program; if not, write to the Free Software Foundation, Inc., ##
26 ## 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ##
27 ## ##
28 ## ------------------------------------------------------------------------- ##
29 ## ##
30 ## Author .....: Daniel Scheibli <daniel@scheibli.com> ##
31 ## Date .......: 2000-05-17 ##
32 ## Changes ....: ----- ApaLogFilter 0.99.010 ------------------------------ ##
33 ## 2006-09-03 o Updated code layout and program outputs. ##
34 ## ----- ApaLogFilter 0.99.009 ------------------------------ ##
35 ## 2002-08-06 o Improved performance by differenciating the ##
36 ## RequestUrl.n.Value content into cases with ##
37 ## STRING and with REGEXP value. ##
38 ## ----- ApaLogFilter 0.99.008 ------------------------------ ##
39 ## 2001-03-12 o Added prototype for function main(). ##
40 ## 2001-09-18 o FEATURE: Added new keyword $ALL for ##
41 ## RequestUrl.n.Title ##
42 ## ----- ApaLogFilter 0.99.007 ------------------------------ ##
43 ## 2001-01-22 o FEATURE: Now possible, to use RegExp's for ##
44 ## Remote Host field. ##
45 ## ----- ApaLogFilter 0.99.006 ------------------------------ ##
46 ## 2000-12-30 o FEATURE: Added feature to allow all records ##
47 ## to go to the outfile when there are no ##
48 ## RegExp. entry (for matching) are defined ##
49 ## at all. ##
50 ## 2000-12-31 o Changed all comments in code to english. ##
51 ## 2000-12-31 o Changed the documentation. ##
52 ## ----- ApaLogFilter 0.99.005 ------------------------------ ##
53 ## 2000-12-29 o BUGFIX: Negative TZ not gets accepted. ##
54 ## ----- ApaLogFilter 0.99.004 ------------------------------ ##
55 ## 2000-12-03 o Changed the license to GPL. ##
56 ## 2000-12-03 o Changed the documentation. ##
57 ## ----- ApaLogFilter 0.99.003 ------------------------------ ##
58 ## 2000-08-14 o FEATURE: Added the function of replacing ##
59 ## HTTP statuscodes. ##
60 ## ----- ApaLogFilter 0.99.002 ------------------------------ ##
61 ## 2000-06-12 o Changed comments in code. ##
62 ## 2000-06-13 o FEATURE: Added the function of a seperate ##
63 ## ExceptionFile. ##
64 ## ##
65 ###############################################################################
66
67
68
69 # Presettings
70
71 use English;
72 use strict;
73
74 use File::Basename;
75 use FindBin qw( $Bin );
76 use IO::File;
77
78 sub TRUE { 1 }
79 sub FALSE { 0 }
80 sub NULL { undef } # DANGER: Never change this!!!
81 sub OK { 0 }
82 sub WARNING { 2 }
83 sub ERROR { 4 }
84
85 sub Program_Init_ParseArguments();
86 sub Program_Init_ConfigRead();
87 sub Program_Action_ProcessAccessLog();
88
89 my %hGlobalVars = (
90 "Program.Rc" => 0, # Return-Code
91 "Program.Version" => "APALOGFILTER 0.99.010", # Version-Token
92 "Program.Environment.NewLine" => "\n", # NewLine-Token for the current environment
93 "Program.Environment.Seperator" => "/", # PathSeperator-Token for the current environment
94 "Program.Obj.CfgFile.Name" => "ApaLogFilter.cfg", # Name of the Configurationfile
95 "Program.Param.InputFileName" => "", # Name of the Apache-Logfile to process (INPUT)
96 "Program.Param.OutputFileName" => "", # Name of the Apache-Logfile for the results (OUTPUT)
97 "Program.Param.ExceptionFileName" => "", # Name of the Exception-Logfile for Exception-Rows
98 "Program.Config.RemoteHost" => [], # Settings for the "Client"-field
99 "Program.Config.RequestUrl" => [], # Settings for the "URL"-field
100 "Program.Config.Status" => [], # Settings for the "Status"-field
101 "Program.Config.ReferredUrl" => [] # Settings for the "ReferredURL"-field
102 );
103 $hGlobalVars{"Program.Obj.CfgFile.Name"} = $Bin.
104 $hGlobalVars{"Program.Environment.Seperator"}.
105 $hGlobalVars{"Program.Obj.CfgFile.Name"};
106
107
108
109 # Program initialization
110
111 printf( "%s%s",
112 $hGlobalVars{"Program.Version"},
113 $hGlobalVars{"Program.Environment.NewLine"} );
114
115 Program_Init_ParseArguments();
116 Program_Init_ConfigRead();
117
118 printf( "INFO: Number of RequestUrl entries = %s%s",
119 scalar@{$hGlobalVars{"Program.Config.RequestUrl"}},
120 $hGlobalVars{"Program.Environment.NewLine"} );
121
122
123
124 # Process the web server's access log file
125
126 Program_Action_ProcessAccessLog();
127
128 exit( OK );
129
130
131
132
133
134 ###############################################################################
135 ## ##
136 ## P R O G R A M _ I N I T _ P A R S E A R G U M E N T S ##
137 ## ##
138 ###############################################################################
139 sub Program_Init_ParseArguments() {
140
141 # Presettings
142
143 my( $sCallRc );
144
145
146
147 # Process the parameters/arguments given to the program
148
149 my @aParamMarkerDefinitions = (
150 {
151 "HashKey" => "Program.Param.InputFileName",
152 "ArgToken" => "-in",
153 "Definition" => "STRING:Y"
154 },{
155 "HashKey" => "Program.Param.OutputFileName",
156 "ArgToken" => "-out",
157 "Definition" => "STRING:Y"
158 },{
159 "HashKey" => "Program.Param.ExceptionFileName",
160 "ArgToken" => "-exf",
161 "Definition" => "STRING:Y"
162 }
163 );
164
165 $sCallRc = ParseArguments( \@ARGV, \@aParamMarkerDefinitions, \%hGlobalVars );
166
167 if( $sCallRc != OK ) {
168
169 my( @aRows );
170
171 push( @aRows, "===> ERROR: Unknown arguments (Rc: ".$sCallRc.")." );
172 push( @aRows, "" );
173 push( @aRows, "Call ........: >>--- ApaLogFilter.pl --- -in FILE --- -out FILE --->" );
174 push( @aRows, "" );
175 push( @aRows, " >--- -exf FILE ---><" );
176 push( @aRows, "" );
177 push( @aRows, "Sample ......: ApaLogFilter.pl -in access.log -out access.flg -exf access.err" );
178 push( @aRows, "" );
179 push( @aRows, "Arguments ...: -in FILE Full qualified name of the AccessLogFile" );
180 push( @aRows, " to process." );
181 push( @aRows, " -out FILE Full qualified name of the ResultFile." );
182 push( @aRows, " -exf FILE Full qualified name of the ExceptionFile." );
183 push( @aRows, "" );
184
185 foreach( @aRows ) {
186 printf( "%s%s", $_, $hGlobalVars{"Program.Environment.NewLine"} );
187 }
188
189 exit( ERROR );
190 }
191 }
192
193
194
195
196
197 ###############################################################################
198 ## ##
199 ## P R O G R A M _ I N I T _ C O N F I G R E A D ##
200 ## ##
201 ###############################################################################
202 sub Program_Init_ConfigRead() {
203
204 # Presettings
205
206 my( $oCfgFile, $rhKeyValue, $sIndex, $sSubIndex );
207 my( $rhReqExpArray, $rhStringArray );
208 my( $sCallRc, $sDummy, $I );
209
210
211
212 # Open and read the ConfigFile
213
214 $rhKeyValue = ParseConfigurationFile( $hGlobalVars{"Program.Obj.CfgFile.Name"} );
215 if( ! ref( $rhKeyValue ) ) {
216 printf( "===> ERROR: Unable to open/read the ConfigFile (Rc: %s)%s", $sCallRc, $hGlobalVars{"Program.Environment.NewLine"} );
217 exit( ERROR );
218 }
219
220
221
222 # Process the settings for the "RemoteHost"-field
223
224 for( $sIndex = 1; ; $sIndex++ ) {
225
226 # If there is a RemoteHost.<n> Entry,...
227
228 if( defined( $rhKeyValue->{"REMOTEHOST.".$sIndex.".VALUE"} ) ) {
229
230 # Ensure, that the settings (RemoteHost.<n>.Value) are ok
231
232 if( $rhKeyValue->{"REMOTEHOST.".$sIndex.".VALUE"} eq "" ) {
233 printf( "===> ERROR: The ConfigFile contains an invalid entry.%s", $hGlobalVars{"Program.Environment.NewLine"} );
234 printf( " The value of REMOTEHOST.%s.VALUE is a nullstring.%s", $sIndex, $hGlobalVars{"Program.Environment.NewLine"} );
235 exit( ERROR );
236 }
237
238 # Ensure, that the settings (RemoteHost.<n>.Action) are ok
239
240 unless( ( defined( $rhKeyValue->{"REMOTEHOST.".$sIndex.".ACTION"} ) ) &&
241 ( $rhKeyValue->{"REMOTEHOST.".$sIndex.".ACTION"} eq "EXCLUDE_RECORD" ) ) {
242 printf( "===> ERROR: The ConfigFile contains an invalid entry.%s", $hGlobalVars{"Program.Environment.NewLine"} );
243 printf( " The value of REMOTEHOST.%s.ACTION is invalid or undefined.%s", $sIndex, $hGlobalVars{"Program.Environment.NewLine"} );
244 exit( ERROR );
245 }
246
247 # Added the settings
248
249 push( @{$hGlobalVars{"Program.Config.RemoteHost"}},
250 {
251 "VALUE" => $rhKeyValue->{"REMOTEHOST.".$sIndex.".VALUE"},
252 "ACTION" => $rhKeyValue->{"REMOTEHOST.".$sIndex.".ACTION"}
253 }
254 );
255 }
256 else {
257 last;
258 }
259 }
260
261
262
263 # Process the settings for the "RequestUrl"-field
264
265 for( $sIndex = 1; ; $sIndex++ ) {
266
267 # If there is a RequestUrl.<n> Entry,...
268
269 if( defined( $rhKeyValue->{"REQUESTURL.".$sIndex.".TITLE"} ) ) {
270
271 # Ensure, that the settings (RequestUrl.<n>.Title) are ok
272
273 if( $rhKeyValue->{"REQUESTURL.".$sIndex.".TITLE"} eq "" ) {
274 printf( "===> ERRROR: The ConfigFile contains an invalid entry.%s", $hGlobalVars{"Program.Environment.NewLine"} );
275 printf( " The value of REQUESTURL.%s.TITLE is a nullstring.%s", $sIndex, $hGlobalVars{"Program.Environment.NewLine"} );
276 exit( ERROR );
277 }
278
279 # Walk thrue all possible URL's / ReqExp's
280
281 $rhReqExpArray = [];
282 $rhStringArray = [];
283
284 for( $sSubIndex = 1; ; $sSubIndex++ ) {
285
286 # If there is a RequestUrl.<n>.Value.<m> Entry,...
287
288 if( ( defined( $rhKeyValue->{"REQUESTURL.".$sIndex.".VALUE.".$sSubIndex} ) ) &&
289 ( defined( $rhKeyValue->{"REQUESTURL.".$sIndex.".TYPE.".$sSubIndex} ) ) ) {
290
291 # Ensure, that the settings (RequestUrl.<n>.Value.<m>) are ok
292
293 if( $rhKeyValue->{"REQUESTURL.".$sIndex.".VALUE.".$sSubIndex} eq "" ) {
294 printf( "===> ERROR: The ConfigFile contains an invalid entry.%s", $hGlobalVars{"Program.Environment.NewLine"} );
295 printf( " The value of REQUESTURL.%s.VALUE.%s is invalid or undefined.%s", $sIndex, $sSubIndex, $hGlobalVars{"Program.Environment.NewLine"} );
296 exit( ERROR );
297 }
298
299 # Ensure, that the settings (RequestUrl.<n>.Type.<m>) are ok
300
301 if( $rhKeyValue->{"REQUESTURL.".$sIndex.".TYPE.".$sSubIndex} eq "" ) {
302 printf( "===> ERROR: The ConfigFile contains an invalid entry.%s", $hGlobalVars{"Program.Environment.NewLine"} );
303 printf( " The value of REQUESTURL.%s.TYPE.%s is invalid or undefined.%s", $sIndex, $sSubIndex, $hGlobalVars{"Program.Environment.NewLine"} );
304 exit( ERROR );
305 }
306
307 # Added the settings
308
309 if( $rhKeyValue->{"REQUESTURL.".$sIndex.".TYPE.".$sSubIndex} eq "STRING" ) {
310 push( @{$rhStringArray}, $rhKeyValue->{"REQUESTURL.".$sIndex.".VALUE.".$sSubIndex} );
311 }
312 elsif( $rhKeyValue->{"REQUESTURL.".$sIndex.".TYPE.".$sSubIndex} eq "REGEXP" ) {
313 push( @{$rhReqExpArray}, $rhKeyValue->{"REQUESTURL.".$sIndex.".VALUE.".$sSubIndex} );
314 }
315 else {
316 printf( "===> ERROR: The ConfigFile contains an invalid entry.%s", $hGlobalVars{"Program.Environment.NewLine"} );
317 printf( " The value of REQUESTURL.%s.TYPE.%s is invalid or undefined.%s", $sIndex, $sSubIndex, $hGlobalVars{"Program.Environment.NewLine"} );
318 exit( ERROR );
319 }
320 }
321 else {
322 last;
323 }
324 }
325
326 # Ensure, that there is a minimum of one URL / ReqExp per RequestUrl.<n>.Title entry
327
328 if( ( scalar@{$rhStringArray} < 1 ) && ( scalar@{$rhReqExpArray} < 1) ) {
329 printf( "===> ERROR: The ConfigFile contains an invalid entry.%s", $hGlobalVars{"Program.Environment.NewLine"} );
330 printf( " No entry for REQUESTURL.%s.VALUE.<n> found.%s", $sIndex, $sSubIndex, $hGlobalVars{"Program.Environment.NewLine"} );
331 exit( ERROR );
332 }
333
334 # Added the settings
335
336 push( @{$hGlobalVars{"Program.Config.RequestUrl"}},
337 {
338 "TITLE" => $rhKeyValue->{"REQUESTURL.".$sIndex.".TITLE"},
339 "STRING" => $rhStringArray,
340 "REGEXP" => $rhReqExpArray
341 }
342 );
343 }
344 else {
345 last;
346 }
347 }
348
349
350
351 # Process the settings for the "Status"-field
352
353 for( $sIndex = 1; ; $sIndex++ ) {
354
355 # If there is a Status.<n> Entry,...
356
357 if( defined( $rhKeyValue->{"STATUS.".$sIndex.".VALUE"} ) ) {
358
359 # Ensure, that the settings (Status.<n>.Value) are ok
360
361 if( $rhKeyValue->{"STATUS.".$sIndex.".VALUE"} eq "" ) {
362 printf( "===> ERROR: The ConfigFile contains an invalid entry.%s", $hGlobalVars{"Program.Environment.NewLine"} );
363 printf( " The value of STATUS.%s.VALUE is a nullstring.%s", $sIndex, $hGlobalVars{"Program.Environment.NewLine"} );
364 exit( ERROR );
365 }
366
367 # Ensure, that the settings (Status.<n>.Action) are ok
368
369 unless( ( defined( $rhKeyValue->{"STATUS.".$sIndex.".ACTION"} ) ) &&
370 ( ( $rhKeyValue->{"STATUS.".$sIndex.".ACTION"} eq "FORCE_RECORD_IN_EXCEPTION_LIST" ) ||
371 ( $rhKeyValue->{"STATUS.".$sIndex.".ACTION"} eq "REPLACE_VALUE" ) ) ) {
372 printf( "===> ERROR: The ConfigFile contains an invalid entry.%s", $hGlobalVars{"Program.Environment.NewLine"} );
373 printf( " The value of STATUS.%s.ACTION is invalid or undefined.%s", $sIndex, $hGlobalVars{"Program.Environment.NewLine"} );
374 exit( ERROR );
375 }
376
377 # Ensure, that the there is an NewValue for the Action "Replace_Value"
378
379 if( $rhKeyValue->{"STATUS.".$sIndex.".ACTION"} eq "REPLACE_VALUE" ) {
380 unless( ( defined( $rhKeyValue->{"STATUS.".$sIndex.".NEWVALUE"} ) ) &&
381 ( $rhKeyValue->{"STATUS.".$sIndex.".NEWVALUE"} ne "" ) ) {
382 printf( "===> ERROR: The ConfigFile contains an invalid entry.%s", $hGlobalVars{"Program.Environment.NewLine"} );
383 printf( " The value of STATUS.%s.NEWVALUE is invalid or undefined.%s", $sIndex, $hGlobalVars{"Program.Environment.NewLine"} );
384 exit( ERROR );
385 }
386 }
387
388 # Added the settings
389
390 push( @{$hGlobalVars{"Program.Config.Status"}},
391 {
392 "VALUE" => $rhKeyValue->{"STATUS.".$sIndex.".VALUE"},
393 "ACTION" => $rhKeyValue->{"STATUS.".$sIndex.".ACTION"},
394 "NEWVALUE" => $rhKeyValue->{"STATUS.".$sIndex.".NEWVALUE"}
395 }
396 );
397 }
398 else {
399 last;
400 }
401 }
402
403
404
405 # Process the settings for the "ReferredUrl"-field
406
407 for( $sIndex = 1; ; $sIndex++ ) {
408
409 # If there is a ReferredUrl.<n> Entry,...
410
411 if( defined( $rhKeyValue->{"REFERREDURL.".$sIndex.".VALUE"} ) ) {
412
413 # Ensure, that the settings (ReferredUrl.<n>.Value) are ok
414
415 if( $rhKeyValue->{"REFERREDURL.".$sIndex.".VALUE"} eq "" ) {
416 printf( "===> ERROR: The ConfigFile contains an invalid entry.%s", $hGlobalVars{"Program.Environment.NewLine"} );
417 printf( " The value of REFERREDURL.%s.VALUE is a nullstring.%s", $sIndex, $hGlobalVars{"Program.Environment.NewLine"} );
418 exit( ERROR );
419 }
420
421 # Ensure, that the settings (ReferredUrl.<n>.Action) are ok
422
423 unless( ( defined( $rhKeyValue->{"REFERREDURL.".$sIndex.".ACTION"} ) ) &&
424 ( $rhKeyValue->{"REFERREDURL.".$sIndex.".ACTION"} eq "REPLACE_WITH_BLANK" ) ) {
425 printf( "===> ERROR: The ConfigFile contains an invalid entry.%s", $hGlobalVars{"Program.Environment.NewLine"} );
426 printf( " The value of REFERREDURL.%s.ACTION is invalid or undefined.%s", $sIndex, $hGlobalVars{"Program.Environment.NewLine"} );
427 exit( ERROR );
428 }
429
430 # Added the settings
431
432 push( @{$hGlobalVars{"Program.Config.ReferredUrl"}},
433 {
434 "VALUE" => $rhKeyValue->{"REFERREDURL.".$sIndex.".VALUE"},
435 "ACTION" => $rhKeyValue->{"REFERREDURL.".$sIndex.".ACTION"}
436 }
437 );
438 }
439 else {
440 last;
441 }
442 }
443 }
444
445
446
447
448
449 ###############################################################################
450 ## ##
451 ## P R O G R A M _ A C T I O N _ P R O C E S S A C C E S S L O G ##
452 ## ##
453 ###############################################################################
454 sub Program_Action_ProcessAccessLog() {
455
456 # Presettings
457
458 my(
459 $sClient, $sIdentUser, $sAuthUser,
460 $sDate, $sTime, $sTz,
461 $sMethod, $sUrl, $sProtocol,
462 $sStatus, $sBytes,
463 $sReferred, $sBrowser
464 );
465 my( $sRowNo, $sRow );
466 my( $sFound );
467 my( $oFhOut, $oFhException, $oFhIn, $oFhDummy );
468 my( $sCallRc, $sDummy, $I, $J, @aDummy );
469
470
471
472 # Open output file
473
474 $sDummy = 0;
475 $oFhOut = new IO::File;
476 $oFhOut->open( $hGlobalVars{"Program.Param.OutputFileName"}, O_WRONLY | O_CREAT | O_TRUNC ) or $sDummy = 1;
477
478 if( $sDummy != 0 ) {
479 printf( "===> ERROR: Unable to open the ResultFile.%s", $hGlobalVars{"Program.Environment.NewLine"} );
480 exit( ERROR );
481 }
482 $oFhOut->autoflush( 1 );
483
484
485
486 # Open exception file
487
488 $sDummy = 0;
489 $oFhException = new IO::File;
490 $oFhException->open( $hGlobalVars{"Program.Param.ExceptionFileName"}, O_WRONLY | O_CREAT | O_TRUNC ) or $sDummy = 1;
491
492 if( $sDummy != 0 ) {
493 printf( "===> ERROR: Unable to open the ExceptionFile.%s", $hGlobalVars{"Program.Environment.NewLine"} );
494 exit( ERROR );
495 }
496 $oFhException->autoflush(1);
497
498
499
500 # Open the web server access log file
501
502 $sDummy = 0;
503 $oFhIn = new IO::File;
504 $oFhIn->open( $hGlobalVars{"Program.Param.InputFileName"}, O_RDONLY ) or $sDummy = 1;
505
506 if( $sDummy != 0 ) {
507 printf( "===> ERROR: Unable to open the AccessLogFile.%s", $hGlobalVars{"Program.Environment.NewLine"} );
508 exit( ERROR );
509 }
510
511
512
513 # Walk through the web server access log files
514
515 READ_LOOP: for(;;) {
516
517 # Presettings
518
519 $sRowNo++;
520 if( $sRowNo % 500 == 0 ) {
521 printf( "Processing row number %ld ...%s", $sRowNo, $hGlobalVars{"Program.Environment.NewLine"} );
522 }
523 $oFhDummy = $oFhOut;
524
525 # Read next row
526
527 $_ = $oFhIn->getline();
528 if( defined( $_ ) ) {
529 chomp( $_ );
530 }
531 else {
532 last READ_LOOP;
533 }
534
535 # Split of the aktual row into the contained tokens/fields
536
537 ( $sClient, $sIdentUser, $sAuthUser,
538 $sDate, $sTime, $sTz,
539 $sMethod, $sUrl, $sProtocol,
540 $sStatus, $sBytes,
541 $sReferred, $sBrowser ) = /^(\S+) (\S+) (\S+) \[(\S+):(\d+:\d+:\d+) (\S+)\] "(\S+) (.*?) (\S+)" (\S+) (\S+) "(.*?)" "(.*?)"/;
542
543 # Ensure, that all fields could be reed
544
545 if( ! defined( $sBrowser ) ) {
546 printf( "===> ERROR: Corrupted Record (RowNo: %i).%s", $sRowNo, $hGlobalVars{"Program.Environment.NewLine"} );
547 exit( ERROR );
548 }
549
550 ANALYSE_LOOP: for(;;) {
551
552 # Walk thrue the settings for status field
553
554 for( $I = 0; $I < scalar@{$hGlobalVars{"Program.Config.Status"}}; $I++ ) {
555
556 # If status matches,...
557
558 if( $hGlobalVars{"Program.Config.Status"}->[$I]->{"VALUE"} eq $sStatus ) {
559
560 # If transfer of row to exception file is wanted,...
561
562 if( $hGlobalVars{"Program.Config.Status"}->[$I]->{"ACTION"} eq "FORCE_RECORD_IN_EXCEPTION_LIST" ) {
563 $oFhDummy = $oFhException;
564 last ANALYSE_LOOP;
565 }
566
567 # If replacement of the value is wanted,...
568
569 if( $hGlobalVars{"Program.Config.Status"}->[$I]->{"ACTION"} eq "REPLACE_VALUE" ) {
570 $sStatus = $hGlobalVars{"Program.Config.Status"}->[$I]->{"NEWVALUE"};
571 }
572 }
573 }
574
575
576 # Walk thrue the settings for remote host field (only for EXCLUDE)
577
578 for( $I = 0; $I < scalar@{$hGlobalVars{"Program.Config.RemoteHost"}}; $I++ ) {
579
580 # Presettings
581
582 $sDummy = $hGlobalVars{"Program.Config.RemoteHost"}->[$I]->{"VALUE"};
583
584 # If remote host matches,...
585
586 if( $sClient =~ /^$sDummy$/ ) {
587
588 # If EXCLUDE is wanted,...
589
590 if( $hGlobalVars{"Program.Config.RemoteHost"}->[$I]->{"ACTION"} eq "EXCLUDE_RECORD" ) {
591 next READ_LOOP;
592 }
593 }
594 }
595
596 # Walk thrue the settings for request url
597
598 $sFound = 0;
599 LOOP3: for( $I = 0; $I < scalar@{$hGlobalVars{"Program.Config.RequestUrl"}}; $I++ ) {
600 for( $J = 0; $J < scalar@{$hGlobalVars{"Program.Config.RequestUrl"}->[$I]->{"STRING"}}; $J++ ) {
601
602 # Presettings
603
604 $sDummy = $hGlobalVars{"Program.Config.RequestUrl"}->[$I]->{"STRING"}->[$J];
605
606 # If request url matches,...
607
608 if( $sUrl eq $sDummy ) {
609
610 $sFound = 1;
611 $sDummy = Translate( ' ', '_', undef, $hGlobalVars{"Program.Config.RequestUrl"}->[$I]->{"TITLE"} );
612 if( index( $sDummy, '$ALL' ) >= 0 ) {
613 $sDummy = $sUrl;
614 }
615 elsif( index( $sDummy, '$FILE' ) >= 0 ) {
616 $sDummy = Replace( '\$FILE', basename( $sUrl ), $sDummy );
617 }
618 $sUrl = $sDummy;
619 last LOOP3;
620 }
621 }
622 for( $J = 0; $J < scalar@{$hGlobalVars{"Program.Config.RequestUrl"}->[$I]->{"REGEXP"}}; $J++ ) {
623
624 # Presettings
625
626 $sDummy = $hGlobalVars{"Program.Config.RequestUrl"}->[$I]->{"REGEXP"}->[$J];
627
628 # If request url matches,...
629
630 if( $sUrl =~ /^$sDummy$/ ) {
631
632 $sFound = 1;
633 $sDummy = Translate( ' ', '_', undef, $hGlobalVars{"Program.Config.RequestUrl"}->[$I]->{"TITLE"} );
634 if( index( $sDummy, '$ALL' ) >= 0 ) {
635 $sDummy = $sUrl;
636 }
637 elsif( index( $sDummy, '$FILE' ) >= 0 ) {
638 $sDummy = Replace( '\$FILE', basename( $sUrl ), $sDummy );
639 }
640 $sUrl = $sDummy;
641 last LOOP3;
642 }
643 }
644 }
645
646 # If current row doesn't match any defined Request-URL,...
647
648 if( ( $sFound == 0 ) && ( scalar@{$hGlobalVars{"Program.Config.RequestUrl"}} > 0 ) ) {
649 next READ_LOOP;
650 }
651
652 # Walk thrue the settings for referred url (for REPLACE)
653
654 for( $I = 0; $I < scalar@{$hGlobalVars{"Program.Config.ReferredUrl"}}; $I++ ) {
655
656 # If referred url matches and replacement is wanted,...
657
658 if( ( index( $sReferred, $hGlobalVars{"Program.Config.ReferredUrl"}->[$I]->{"VALUE"} ) == 0 ) &&
659 ( $hGlobalVars{"Program.Config.ReferredUrl"}->[$I]->{"ACTION"} eq "REPLACE_WITH_BLANK" ) ) {
660 $sReferred = "-";
661 }
662 }
663
664 last ANALYSE_LOOP;
665 }
666
667 # Assemble the new row in CLF format
668
669 $sRow = $sClient;
670 $sRow = $sRow." ". $sIdentUser;
671 $sRow = $sRow." ". $sAuthUser;
672 $sRow = $sRow." [". $sDate;
673 $sRow = $sRow.":". $sTime;
674 $sRow = $sRow." ". $sTz;
675 $sRow = $sRow.'] "'.$sMethod;
676 $sRow = $sRow." ". $sUrl;
677 $sRow = $sRow." ". $sProtocol;
678 $sRow = $sRow.'" '. $sStatus;
679 $sRow = $sRow." ". $sBytes;
680 $sRow = $sRow.' "'. $sReferred;
681 $sRow = $sRow.'" "'.$sBrowser;
682 $sRow = $sRow.'"';
683
684 # Write new row to output / exception file
685
686 $sDummy = 0;
687 $oFhDummy->printf( "%s%s", $sRow, $hGlobalVars{"Program.Environment.NewLine"} ) or $sDummy = 1;
688
689 if( $sDummy != 0 ) {
690 printf( "===> ERROR: Unable to write into the Result/ExceptionFile.%s", $hGlobalVars{"Program.Environment.NewLine"} );
691 exit( ERROR );
692 }
693 }
694
695 close($oFhIn);
696 close($oFhException);
697 close($oFhOut);
698 }
699
700
701
702
703
704 ###############################################################################
705 ## ##
706 ## P A R S E C O N F I G U R A T I O N F I L E ##
707 ## ##
708 ###############################################################################
709 sub ParseConfigurationFile($) {
710
711 # NOTE: This code is very basic, but works and allows one to
712 # parse a file like the one described in the box (the standard
713 # Perl functions are not sufficient for that).
714
715 # TODO: Have a second look at the available CPAN modules.
716
717 # +------------------------------------------------------------------+
718 # | #BEGIN |
719 # | # CommentToken |
720 # | KeyToken1.KeyToken2 = ValueToken1 ValueToken2 \ # CommentToken |
721 # | ValueToken3 # CommentToken |
722 # | #END |
723 # +------------------------------------------------------------------+
724
725
726
727 # Presettings
728
729 my( $sFileName ) = @_;
730 my $oFh = undef;
731 my $rhKeyValueRows = {};
732 my $sDummy;
733
734
735
736 # Open the configuration file
737
738 $sDummy = OK;
739 $oFh = new IO::File;
740 $oFh->open( $sFileName, O_RDONLY ) or $sDummy = ERROR;
741
742 if( $sDummy != OK ) {
743 $oFh = undef;
744 return( -5 );
745 }
746
747
748
749 # Walk thrue all rows in config file
750
751 my( $sBeginRowFlag, $sEndRowFlag, $sRowNo ) = ( FALSE, FALSE, 0 );
752 my( $sCurrentRowOrg );
753 my( $sCurrentRowKeyValue, $sCurrentRowComment );
754 my( $sCurrentRowKey, $sCurrentRowValue );
755 my( $sCommentPos, $sEqualPos );
756 my( $I, $sBackSlashesNoOf );
757 my( $sKey4FollowRow, $sRowNo2Follow ) = ( "", -1 );
758
759 while( defined( $sCurrentRowOrg = $oFh->getline() ) ) {
760
761 # Presettings
762
763 chomp( $sCurrentRowOrg );
764 $sCommentPos = index( $sCurrentRowOrg, '#' );
765 $sRowNo++;
766
767 # Cut out the comment from row
768
769 if( $sCommentPos < 0 ) {
770 $sCommentPos = length( $sCurrentRowOrg );
771 }
772 $sCurrentRowKeyValue = Strip( substr( $sCurrentRowOrg, 0, $sCommentPos ) );
773 $sCurrentRowComment = Strip( Space( 0, ' ', uc( substr( $sCurrentRowOrg, $sCommentPos ) ) ) );
774
775 # Check for pure comment row
776
777 if( ( $sCurrentRowKeyValue eq "" ) && ( $sCurrentRowComment ne "" ) ) {
778 $sRowNo--;
779 next;
780 }
781
782 # Check for key/value or value containing rows
783
784 elsif( $sCurrentRowKeyValue ne "" ) {
785
786 # Presettings
787
788 $sEqualPos = index( $sCurrentRowKeyValue, '=' );
789
790 # If row is a key/value row,...
791
792 if( $sEqualPos >= 0 ) {
793
794 # Split the row into key- and value-part
795
796 $sCurrentRowKey = Strip( uc( substr( $sCurrentRowKeyValue, 0, $sEqualPos ) ) );
797 $sCurrentRowValue = Strip( substr( $sCurrentRowKeyValue, $sEqualPos+1 ) );
798
799 # Ensure, that there is a valid key name
800
801 if( $sCurrentRowKey eq "" ) {
802 return( -3 );
803 }
804
805 # Get the number of backslashes at the end of row
806
807 $sBackSlashesNoOf = 0;
808
809 for( $I = length( $sCurrentRowValue ); $I > 0; $I-- ) {
810 if( substr( $sCurrentRowValue, $I-1, 1 ) eq '\\' ) {
811 $sBackSlashesNoOf++;
812 }
813 else {
814 last;
815 }
816 }
817
818 # Process the indicator for a following row (number of backslashes = 1,3,5,...)
819
820 if( $sBackSlashesNoOf % 2 != 0 ) {
821 $sCurrentRowValue = Strip( substr( $sCurrentRowValue, 0, length( $sCurrentRowValue ) - 1 ) );
822 $sKey4FollowRow = $sCurrentRowKey;
823 $sRowNo2Follow = $sRowNo;
824 }
825
826 # Write key/value into the hash (replace duplicated backslashes with single once)
827
828 $sCurrentRowValue = Replace( '\\\\\\\\', '\\\\', $sCurrentRowValue );
829 $$rhKeyValueRows{$sCurrentRowKey} = $sCurrentRowValue;
830 next;
831 }
832
833 # Otherwise (row is treated as a value row),...
834
835 else {
836
837 # Ensure, that a following row is wanted
838
839 if( ( $sKey4FollowRow eq "" ) || ( ( $sRowNo2Follow + 1 ) != $sRowNo ) ) {
840 return( -4 );
841 }
842
843 # Split row into key- and value- token
844
845 $sCurrentRowKey = "";
846 $sCurrentRowValue = $sCurrentRowKeyValue;
847
848 # Get number of backslashes
849
850 $sBackSlashesNoOf = 0;
851
852 for( $I = length( $sCurrentRowValue ); $I > 0; $I-- ) {
853 if( substr( $sCurrentRowValue, $I-1, 1 ) eq '\\' ) {
854 $sBackSlashesNoOf++;
855 }
856 else {
857 last;
858 }
859 }
860
861 # Process the indication for following row (number of backslashes = 1,3,5,...)
862
863 if( $sBackSlashesNoOf % 2 != 0 ) {
864 $sCurrentRowValue = Strip( substr( $sCurrentRowValue, 0, length( $sCurrentRowValue ) - 1 ) );
865 $sRowNo2Follow = $sRowNo;
866 }
867 else {
868 $sRowNo2Follow = -1;
869 }
870
871 # Write key/value into hash (replace duplicated bashslashes with single once)
872
873 $sCurrentRowValue = Replace( '\\\\\\\\', '\\\\', $sCurrentRowValue );
874 $$rhKeyValueRows{$sKey4FollowRow} = $$rhKeyValueRows{$sKey4FollowRow}.$sCurrentRowValue;
875
876 next;
877 }
878 }
879
880 # Otherwise (empty row),...
881
882 else {
883 $sRowNo2Follow = -1;
884 next;
885 }
886 }
887
888
889
890 # Close file when needed and return the key/value pairs
891
892 if( defined( $oFh ) ) {
893 close( $oFh );
894 }
895
896 return( $rhKeyValueRows );
897 }
898
899
900
901
902
903 ###############################################################################
904 ## ##
905 ## P A R S E A R G U M E N T S ##
906 ## ##
907 ###############################################################################
908 sub ParseArguments($$$) {
909
910 # Presettings
911
912 my( $raArguments, $raMarkerDefinitions, $rhTargetHash ) = @_;
913 my( $I, $sIndexPos, $sDummy, @aDummy, %hArgTokenIndex );
914
915
916
917 # Check and extent the given list of parameter markers
918
919 for( $I = 0; $I < scalar@$raMarkerDefinitions; $I++ ) {
920
921 # Check the definition of the parameter markers
922
923 @aDummy = split( ":", $$raMarkerDefinitions[$I]->{"Definition"} );
924 foreach( @aDummy ) {
925 $_ = Strip( uc( $_ ) );
926 }
927
928 # Check for (enough) definitions per parameter marker
929
930 if( ( ! defined( $aDummy[0] ) ) || ( ! defined( $aDummy[1] ) ) ) {
931 return( -1 );
932 }
933
934 # Check for valid type of parameter marker
935
936 if( ( $aDummy[0] ne "FLAG" ) && ( $aDummy[0] ne "BOOLEAN" ) && ( $aDummy[0] ne "STRING" ) ) {
937 return( -2 );
938 }
939
940 # Check for settings if parameter marker is a must in the list of arguments,...
941
942 if( $aDummy[1] eq "Y" ) {
943 $aDummy[1] = TRUE;
944 }
945 elsif( $aDummy[1] eq "N" ) {
946 $aDummy[1] = FALSE;
947 }
948 elsif( $aDummy[0] eq "FLAG" ) {
949 $aDummy[1] = FALSE;
950 }
951 else {
952 return( -3 );
953 }
954
955 # Extent the list of parameter markers
956
957 $$raMarkerDefinitions[$I]->{"FoundCounter"} = 0;
958 $$raMarkerDefinitions[$I]->{"Def.Type"} = $aDummy[0];
959 $$raMarkerDefinitions[$I]->{"Def.MustBeThere"} = $aDummy[1];
960
961 # Additional Settings
962
963 $hArgTokenIndex{$$raMarkerDefinitions[$I]->{"ArgToken"}} = $I;
964 }
965
966
967
968 # Walk thrue the given list of arguments
969
970 for( $I = 0; $I < scalar@$raArguments; $I++ ) {
971
972 # If argument matches one of the parameter markers,...
973
974 if( defined( $hArgTokenIndex{$$raArguments[$I]} ) ) {
975
976 # Presettings
977
978 $sIndexPos = $hArgTokenIndex{$$raArguments[$I]};
979 $$raMarkerDefinitions[$sIndexPos]->{"FoundCounter"}++;
980
981 # Do processing depending on the defined type for the parameter marker
982
983 if( $$raMarkerDefinitions[$sIndexPos]->{"Def.Type"} eq "FLAG" ) {
984 $$raMarkerDefinitions[$sIndexPos]->{"Value"} = TRUE;
985 }
986 elsif( $$raMarkerDefinitions[$sIndexPos]->{"Def.Type"} eq "BOOLEAN" ) {
987
988 # Ensure, that a arguments follows which is not a parameter marker
989
990 if( ( $I + 1 ) < scalar@$raArguments ) {
991 $sDummy = $hArgTokenIndex{$$raArguments[$I+1]};
992 if( defined( $sDummy ) ) {
993 return( -6 );
994 }
995 }
996 else {
997 return( -5 );
998 }
999
1000 # Process the parameter marker following argument
1001
1002 $sDummy = uc( $$raArguments[$I+1] );
1003 if( ( $sDummy eq "ON" ) || ( $sDummy eq "YES" ) || ( $sDummy eq "TRUE" ) ) {
1004 $$raMarkerDefinitions[$sIndexPos]->{"Value"} = TRUE;
1005 }
1006 elsif( ( $sDummy eq "OFF" ) || ( $sDummy eq "NO" ) || ( $sDummy eq "FALSE" ) ) {
1007 $$raMarkerDefinitions[$sIndexPos]->{"Value"} = FALSE;
1008 }
1009 else {
1010 return( -7 );
1011 }
1012
1013 # Increase the argument index (to skip the second argument)
1014
1015 $I++;
1016 }
1017 elsif( $$raMarkerDefinitions[$sIndexPos]->{"Def.Type"} eq "STRING" ) {
1018
1019 # Ensure, that a arguments follows which is not a parameter marker
1020
1021 if( ( $I + 1 ) < scalar@$raArguments ) {
1022 $sDummy = $hArgTokenIndex{$$raArguments[$I+1]};
1023 if( defined( $sDummy ) ) {
1024 return( -8 );
1025 }
1026 }
1027 else {
1028 return( -9 );
1029 }
1030
1031 # Process the parameter marker following argument
1032
1033 $$raMarkerDefinitions[$sIndexPos]->{"Value"} = $$raArguments[$I+1];
1034
1035 # Increase the argument index (to skip the second argument)
1036
1037 $I++;
1038 }
1039 else {
1040 return( -4 );
1041 }
1042 }
1043 else {
1044 return( -10 );
1045 }
1046 }
1047
1048
1049
1050 # Ensure, that all "must" parameter markers are found in argument list
1051
1052 for( $I = 0; $I < scalar@$raMarkerDefinitions; $I++ ) {
1053
1054 # Check if every "must" parameter marker was found
1055
1056 if( ( $$raMarkerDefinitions[$I]->{"Def.MustBeThere"} ) &&
1057 ( $$raMarkerDefinitions[$I]->{"FoundCounter"} <= 0 ) ) {
1058 return( -11 );
1059 }
1060
1061 # Check if a "must" parameter marker was found more than one time
1062
1063 if( $$raMarkerDefinitions[$I]->{"FoundCounter"} > 1 ) {
1064 return( -12 );
1065 }
1066 }
1067
1068
1069
1070 # Write the values/defaults for the defined parameter markers
1071
1072 for( $I = 0; $I < scalar@$raMarkerDefinitions; $I++ ) {
1073
1074 # If parameter marker was found in arguments,...
1075
1076 if( $$raMarkerDefinitions[$I]->{"FoundCounter"} > 0 ) {
1077 $$rhTargetHash{$$raMarkerDefinitions[$I]->{"HashKey"}} = $$raMarkerDefinitions[$I]->{"Value"};
1078 }
1079
1080 # If parameter marker wasn't found in arguments (but has a default),...
1081
1082 elsif( exists( $$raMarkerDefinitions[$I]->{"Default"} ) ) {
1083 $$rhTargetHash{$$raMarkerDefinitions[$I]->{"HashKey"}} = $$raMarkerDefinitions[$I]->{"Default"};
1084 }
1085 }
1086
1087
1088
1089 return( OK );
1090 }
1091
1092
1093
1094
1095
1096 ###############################################################################
1097 ## ##
1098 ## R E P L A C E ##
1099 ## ##
1100 ###############################################################################
1101 sub Replace($$@) {
1102
1103 my( $sFromPattern, $sToPattern, @aRc ) = @_;
1104 my $sStmt;
1105
1106 for( @aRc ) {
1107 $sStmt="s/$sFromPattern/$sToPattern/g;";
1108 eval $sStmt;
1109 }
1110
1111 return wantarray ? @aRc : $aRc[0];
1112 }
1113
1114
1115
1116
1117
1118 ###############################################################################
1119 ## ##
1120 ## S P A C E ##
1121 ## ##
1122 ###############################################################################
1123 sub Space($$@) {
1124
1125 my( $sNoOfSpaces, $sReplaceChar, @aRc ) = @_;
1126 my $sReplaceToken = ( ( defined( $sReplaceChar ) ) ? $sReplaceChar : " " ) x $sNoOfSpaces;
1127
1128 for( @aRc ) {
1129 s/\s+/$sReplaceToken/g;
1130 }
1131
1132 return wantarray ? @aRc : $aRc[0];
1133 }
1134
1135
1136
1137
1138
1139 ###############################################################################
1140 ## ##
1141 ## S T R I P ##
1142 ## ##
1143 ###############################################################################
1144 sub Strip(@) {
1145
1146 my @aArray = @_;
1147
1148 foreach( @aArray ) {
1149 s/^\s+//;
1150 s/\s+$//;
1151 }
1152
1153 return wantarray ? @aArray : $aArray[0];
1154 }
1155
1156
1157
1158
1159
1160 ###############################################################################
1161 ## ##
1162 ## T R A N S L A T E ##
1163 ## ##
1164 ###############################################################################
1165 sub Translate($$$@) {
1166
1167 my( $sFromPattern, $sToPattern, $sOption, @aRc ) = @_;
1168 my $sStmt;
1169
1170 if( !defined( $sOption ) ) {
1171 $sOption = "";
1172 }
1173
1174 for( @aRc ) {
1175 $sStmt = "tr/$sFromPattern/$sToPattern/$sOption;";
1176 eval $sStmt;
1177 }
1178
1179 return wantarray ? @aRc : $aRc[0];
1180 }
1181
1182
1183
1184