"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.
For more information about "ApaLogFilter.pl" see the
Fossies "Dox" file reference documentation.
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