/calamaris-2.59/calamaris

# · Perl · 3372 lines · 3172 code · 74 blank · 126 comment · 356 complexity · 8d9cb1a84b53ca09ed88d6b075ab5133 MD5 · raw file

Large files are truncated click here to view the full file

    

  1. #!/usr/bin/perl -w
    2. 

  2. #
    3. 

  3. # $Id: calamaris,v 2.59 2004/06/06 16:26:14 cord Exp $
    4. 

  4. #
    5. 

  5. # DESCRIPTION: calamaris - statistic package for diverse Proxy-Cache-Servers
    6. 

  6. #
    7. 

  7. # Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 Cord Beermann
    8. 

  8. #
    9. 

  9. # URL: http://Calamaris.Cord.de/
    10. 

  10. # Announcement-Mailing-list: send Mail with 'subscribe' in the Mail-Body to
    11. 

  11. #			     Calamaris-announce-request@Cord.de
    12. 

  12. #
    13. 

  13. # AUTHOR: Cord Beermann <Cord@Wunder-Nett.org>
    14. 

  14. #
    15. 

  15. # Thanks to these contributors, bug reporters, and feature requesters:
    16. 

  16. #	John Heaton <John@MCC.ac.uk>
    17. 

  17. #	Andreas Lamprecht <Andreas.Lamprecht@siemens.at>
    18. 

  18. #	Kenny Ng <kennyng@cyberway.com.sg>
    19. 

  19. #	Claus Langhans <langhans@rz.uni-frankfurt.de>
    20. 

  20. #	Andreas Jung <ajung@sz-sb.de>
    21. 

  21. #	Ernst Heiri <heiri@switch.ch>
    22. 

  22. #	Shamil R. Yahin <SSHY@cclib.nsu.ru>
    23. 

  23. #	Thoralf Freitag <Thoralf.Freitag@isst.fhg.de>
    24. 

  24. #	Marco Paganini <paganini@paganini.net>
    25. 

  25. #	Michael Riedel <mr@fto.de>
    26. 

  26. #	Kris Boulez <krbou@pgsgent.be>
    27. 

  27. #	Mark Visser <mark@snt.utwente.nl>
    28. 

  28. #	Gary Palmer <gjp@erols.com>
    29. 

  29. #	Stefan Watermann <stefan@metronet.de>
    30. 

  30. #	Roar Smith <Roar.Smith@Ericsson.Dk>
    31. 

  31. #	Bernd Lienau <lienau@tli.de>
    32. 

  32. #	Gary Lindstrom <gplindstrom@exodus.nnc.edu>
    33. 

  33. #	Jost Krieger <Jost.Krieger@ruhr-uni-bochum.de>
    34. 

  34. #	Gerd Michael Hoffmann <Hoffmann@dvgw.de>
    35. 

  35. #	Gerold Meerkoetter <gerold@noc.fh-lippe.de>
    36. 

  36. #	Iain Lea <iain@bricbrac.de>
    37. 

  37. #	Emmanuel Adeline <emmanuel.adeline@mail.dotcom.fr>
    38. 

  38. #	John Line <webadm@info.cam.ac.uk>
    39. 

  39. #	Christos Cheretakis <xalkina@otenet.gr>
    40. 

  40. #	Ryan Donnelly <rmd@doit.wisc.edu>
    41. 

  41. #	Richard Vaughan <richard_vaughan@timewarp.co.uk>
    42. 

  42. #	Jonas Luster <jonas@nethammer.qad.org>
    43. 

  43. #	Clare Lahiff <Clare.Lahiff@anu.edu.au>
    44. 

  44. #	Toni Andjelkovic <toni@telecom.at>
    45. 

  45. #	Chris Teakle <ccteakle@its.uq.edu.au>
    46. 

  46. #	Dancer Vesperman <dancer@zeor.simegen.com>
    47. 

  47. #	Vincent ? <vincent@aib.net>
    48. 

  48. #	Elrond ? <Elrond@Wunder-Nett.org>
    49. 

  49. #	Holger Marzen <holger@marzen.de>
    50. 

  50. #	Panagiotis Christias <P.Christias@noc.ntua.gr>
    51. 

  51. #	Patrik Rak <patrik@ash.ein.cz>
    52. 

  52. #	Steve Snyder <swsnyder@insightbb.com>
    53. 

  53. #	Michael Copeland <michael.copeland@bell.ca>
    54. 

  54. #	Warren Brown <wbrown@inktomi.com>
    55. 

  55. #	Andy Nik <nik@che.nsk.su>
    56. 

  56. #	Frank Roechter <frank@fhd.de>
    57. 

  57. #	Antonio Casado Rodríguez <acasado@ualm.es>
    58. 

  58. #	Pavol Adamec <pavol_adamec@tempest.sk>
    59. 

  59. #	Ram Cherukuri <ram@edgix.com>
    60. 

  60. #	Marco Koch <MK@electricpaper.de>
    61. 

  61. #	Stephen Welker <stephen.welker@nemostar.com.au>
    62. 

  62. #	Christian Niederdorfer <christian.niederdorfer@infineon.com>
    63. 

  63. #	Klaus Brinkmeyer <Klaus_Brinkmeyer@inasys.de>
    64. 

  64. #	Filip ? <mechanix@digibel.org>
    65. 

  65. #	Matt Hubbard <m.hubbard@ic.ac.uk>
    66. 

  66. #	James Crocker <jcrocker@menasha.com>
    67. 

  67. #	Enrico Ardizzoni <enrico@unife.it>
    68. 

  68. #	Shawn Switenky <S.Switenky@telesat.ca>
    69. 

  69. #	Jarkko Saloranta <jjs@kpo.fi>
    70. 

  70. #	Jigar Rasalawala <jrasalawala@fourelle.com>
    71. 

  71. #	Philipp Frauenfelder <philipp.frauenfelder@swissonline.ch>
    72. 

  72. #	Alexey Markov <markov@crpi.ru>
    73. 

  73. #	Mark Güthling <privat@mague-pcservice.de>
    74. 

  74. #	Sergey Zarubin <serge-home@yandex.ru>
    75. 

  75. #	Helge Oldach <calamaris@oldach.net>
    76. 

  76. #	Michael R. Schwarzbach <spg@fs.tum.de>
    77. 

  77. #	Radu - Eosif Mihailescu <rmihailescu@lumina.ro>
    78. 

  78. #	Michael Pophal <michael.pophal@nefkom.net>
    79. 

  79. #	Steffen Sledz <sledz@zone42.org>
    80. 

  80. #	Kenytt Avery <kavery@willingminds.com>
    81. 

  81. #	SO Kwok Tsun <ktso@cuhk.edu.hk>
    82. 

  82. #	Chris Knight <chris@aims.com.au>
    83. 

  83. #	ycdtosa ? <ycdtosa@eupla.unizar.es>
    84. 

  84. #	Peter W. Osel <pwo@Infineon.COM>
    85. 

  85. #	Pawel Worach <pawel.worach@nordea.com>
    86. 

  86. 

  87. # This program is free software; you can redistribute it and/or modify it
    88. 

  88. # under the terms of the GNU General Public License as published by the Free
    89. 

  89. # Software Foundation; either version 2 of the License, or (at your option)
    90. 

  90. # any later version.
    91. 

  91. 

  92. # (If you modify and want to publish it under the name 'Calamaris', please ask
    93. 

  93. # me. I don't want to confuse the 'audience' with many different versions of
    94. 

  94. # the same name and/or Version number. (This is not part of the license, it
    95. 

  95. # is only a favour i asked of you.))
    96. 

  96. 

  97. # This program is distributed in the hope that it will be useful, but WITHOUT
    98. 

  98. # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
    99. 

  99. # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
    100. 

  100. # more details.
    101. 

  101. 

  102. # You should have received a copy of the GNU General Public License along with
    103. 

  103. # this program; if not, write to the Free Software Foundation, Inc., 59 Temple
    104. 

  104. # Place - Suite 330, Boston, MA 02111-1307, USA.
    105. 

  105. 

  106. 

  107. # A Perl script is "correct" if it gets the job done before your boss fires
    108. 

  108. # you.
    109. 

  109. #   -- 'Programming Perl Second Edition'
    110. 

  110. #	by Larry Wall, Tom Christiansen & Randal L. Schwartz
    111. 

  111. 

  112. # If you have to remove this, read the README!
    113. 

  113. require 5.002;
    114. 

  114. use vars qw($opt_3 $opt_a $opt_b $opt_c $opt_C $opt_d $opt_D $opt_f $opt_F
    115. 

  115. 	    $opt_h $opt_H $opt_i $opt_I $opt_l $opt_L $opt_m $opt_M $opt_n
    116. 

  116. 	    $opt_N $opt_o $opt_O $opt_p $opt_P $opt_r $opt_R $opt_s $opt_S
    117. 

  117. 	    $opt_t $opt_T $opt_u $opt_U $opt_v $opt_V $opt_w $opt_W $opt_z);
    118. 

  118. use Getopt::Std;
    119. 

  119. use Sys::Hostname;
    120. 

  120. 

  121. getopts('3ab:cCd:D:f:F:hH:i:I:l:LmM:nN:o:Op:P:r:R:sS:t:T:uU:vVwWz');
    122. 

  122. 

  123. if ( $opt_b and $opt_b < 1 ) {
    124. 

  124.   print STDERR "$0: wrong value at -b -option: \"$opt_b\"\n\n";
    125. 

  125.   $usage_err = 1;
    126. 

  126. } else {
    127. 

  127.   $| = 1;
    128. 

  128. }
    129. 

  129. 

  130. if ($opt_U) {
    131. 

  131.   unless ( $opt_U =~ m#^[KMGT]$# ) {
    132. 

  132.     print STDERR "$0: wrong value at -U -option: \"$opt_U\"\n\n";
    133. 

  133.     $usage_err = 1;
    134. 

  134.   }
    135. 

  135. } else {
    136. 

  136.   $opt_U = '';
    137. 

  137. }
    138. 

  138. 

  139. if ($opt_D) {
    140. 

  140.   if ( $opt_D <= 1 ) {
    141. 

  141.     print STDERR "$0: wrong value at -D -option: \"$opt_D\"\n\n";
    142. 

  142.     $usage_err = 1;
    143. 

  143.   }
    144. 

  144. }
    145. 

  145. 

  146. if ($opt_H) {
    147. 

  147.   if ( $opt_H eq '1' or $opt_H eq 'lookup' ) {
    148. 

  148.     $host_name = hostname() . ' ';
    149. 

  149.   } else {
    150. 

  150.     $host_name = $opt_H . ' ';
    151. 

  151.   }
    152. 

  152. } else {
    153. 

  153.   $host_name = '';
    154. 

  154. }
    155. 

  155. 

  156. if ( $opt_N and $opt_N != -1 and $opt_N < 2 ) {
    157. 

  157.   print STDERR "$0: wrong value at -N -option: \"$opt_N\"\n\n";
    158. 

  158.   $usage_err = 1;
    159. 

  159. }
    160. 

  160. 

  161. if ($opt_I) {
    162. 

  162.   use Time::Local;
    163. 

  163.   ( $interval_begin, $interval_end ) = split ( '-', $opt_I );
    164. 

  164.   if ($interval_begin > $interval_end) { 
    165. 

  165.     print STDERR "$0: wrong value at -I -option: \"$opt_I\". Interval begin newer than interval end!\n\n";
    166. 

  166.     $usage_err = 1;
    167. 

  167.   }
    168. 

  168.   if ( $interval_begin =~ m#^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$# ) {
    169. 

  169.     $interval_begin = timegm( $6, $5, $4, $3, $2 - 1, $1 - 1900 );
    170. 

  170.   } elsif ( $interval_begin eq '' ) {
    171. 

  171.     $interval_begin = 0;
    172. 

  172.   } else {
    173. 

  173.     print STDERR "$0: wrong value at -I -option: \"$opt_I\"\n\n";
    174. 

  174.     $usage_err = 1;
    175. 

  175.   }
    176. 

  176.   if ( $interval_end =~ m#^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$# ) {
    177. 

  177.     $interval_end = timegm( $6, $5, $4, $3, $2 - 1, $1 - 1900 );
    178. 

  178.   } elsif ( $interval_end eq '' ) {
    179. 

  179.     $interval_end = 9999999999;
    180. 

  180.   } else {
    181. 

  181.     print STDERR "$0: wrong value at -I -option: \"$opt_I\"\n\n";
    182. 

  182.     $usage_err = 1;
    183. 

  183.   }
    184. 

  184. }
    185. 

  185. 

  186. if ($opt_F) {
    187. 

  187.   foreach $output ( split ( /\s*,\s*/, $opt_F ) ) {
    188. 

  188.     if ( $output eq 'mail' ) {
    189. 

  189.       $outtype_mail = 1;
    190. 

  190.     } elsif ( $output eq 'html' ) {
    191. 

  191.       $outtype_html = 1;
    192. 

  192.     } elsif ( $output eq 'html-embed' ) {
    193. 

  193.       $outtype_htmlembed = 1;
    194. 

  194.     } elsif ( $output eq 'unformatted' ) {
    195. 

  195.       $outtype_unformatted = 1;
    196. 

  196.     } else {
    197. 

  197.       print STDERR "$0: unknown output-format: $output\n\n";
    198. 

  198.       $usage_err = 1;
    199. 

  199.     }
    200. 

  200.   }
    201. 

  201. }
    202. 

  202. 

  203. # remove this at end of 2003
    204. 

  204. if ($opt_3) {
    205. 

  205.   print STDERR "$0: obsoleted option -3: use -N3 instead\n\n";
    206. 

  206.   $usage_err = 1;
    207. 

  207. }
    208. 

  208. 

  209. # remove at end of 2004
    210. 

  210. if ( defined $opt_f and $opt_f =~ m#^squid-(mime|smartfilter)$# ) {
    211. 

  211.   print STDERR "$0: obsoleted input format '$opt_f':
    212. 

  212. 	use -f 'squid-extended' instead\n\n";
    213. 

  213.   $usage_err = 1;
    214. 

  214. }
    215. 

  215. 

  216. # change at end of 2003
    217. 

  217. # remove at end of 2004
    218. 

  218. if ( defined $opt_w ) {
    219. 

  219.   print STDERR "$0: obsoleted output format switch -w:
    220. 

  220.         use -F 'html' instead\n\n";
    221. 

  221.   $outtype_html = 1;
    222. 

  222.   $output_warn = 1;
    223. 

  223. }
    224. 

  224. 

  225. # change at end of 2003
    226. 

  226. # remove at end of 2004
    227. 

  227. if ( defined $opt_W ) {
    228. 

  228.   print STDERR "$0: obsoleted output format switch -W:
    229. 

  229. 	use -F 'html-embed' instead\n\n";
    230. 

  230.   $outtype_htmlembed = 1;
    231. 

  231.   $output_warn = 1;
    232. 

  232. }
    233. 

  233. 

  234. # change at end of 2003
    235. 

  235. # remove at end of 2004
    236. 

  236. if ( defined $opt_m ) {
    237. 

  237.   print STDERR "$0: obsoleted output format switch -m:
    238. 

  238. 	use -F 'mail' instead\n\n";
    239. 

  239.   $outtype_mail = 1;
    240. 

  240.   $output_warn = 1;
    241. 

  241. }
    242. 

  242. 

  243. $sortorder = '';
    244. 

  244. $sortorder = '_size' if ($opt_O);
    245. 

  245. 

  246. if ($opt_a) {
    247. 

  247.   $opt_s = 1;
    248. 

  248.   $opt_P = 60 unless $opt_P;
    249. 

  249.   $opt_d = 20 unless $opt_d;
    250. 

  250.   $opt_r = 20 unless $opt_r;
    251. 

  251.   $opt_t = 20 unless $opt_t;
    252. 

  252.   $opt_D = 10 unless $opt_D;
    253. 

  253. }
    254. 

  254. 

  255. $opt_N = 2 unless $opt_N;
    256. 

  256. $opt_T = 0 unless $opt_T;
    257. 

  257. $opt_r = $opt_R unless $opt_r;
    258. 

  258. 

  259. $P = $opt_P ? "$opt_P minute" : '60 minute';
    260. 

  260. if ( defined($opt_P) and ($opt_P%60) == 0 ) { $P =  $opt_P/60 . " hour" };
    261. 

  261. if ( defined($opt_P) and ($opt_P%1440) == 0 ) { $P =  $opt_P/1440 . " day" };
    262. 

  262. 

  263. if ( $opt_N == -1 or $opt_N > 2 ) {
    264. 

  264.   if ( $opt_N == 3 ) {
    265. 

  265.     $N = '3rd';
    266. 

  266.   } elsif ( $opt_N == -1 ) {
    267. 

  267.     $N = 'all';
    268. 

  268.   } else {
    269. 

  269.     $N = $opt_N . 'th';
    270. 

  270.   }
    271. 

  271. } else {
    272. 

  272.   $N = '2nd';
    273. 

  273. }
    274. 

  274. 

  275. @reports = (
    276. 

  276. 	    'Summary', 'Incoming request peak per protocol',
    277. 

  277. 	    'Incoming transfer volume per protocol',
    278. 

  278. 	    'Incoming requests by method', 'Incoming UDP-requests by status',
    279. 

  279. 	    'Incoming TCP-requests by status', 'Outgoing requests by status',
    280. 

  280. 	    'Outgoing requests by destination',
    281. 

  281. 	    "Request-destinations by ${N}-level-domain",
    282. 

  282. 	    'Request-destinations by toplevel-domain', 'TCP-Request-protocol',
    283. 

  283. 	    'Requested content-type', 'Requested extensions',
    284. 

  284. 	    'Incoming UDP-requests by host', 'Incoming TCP-requests by host',
    285. 

  285. 	    'Distribution Histogram', "Performance in $P steps"
    286. 

  286. 	    );
    287. 

  287. 

  288. $VERSION='Calamaris $Revision: 2.59 $';
    289. 

  289. 

  290. $COPYRIGHT =
    291. 

  291. 'Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 Cord Beermann.
    292. 

  292. Calamaris comes with ABSOLUTELY NO WARRANTY. It is free software, and you are
    293. 

  293. welcome to redistribute it under certain conditions. See source for details.
    294. 

  294. Calamaris-Homepage: http://Calamaris.Cord.de/';
    295. 

  295. 

  296. $USAGE = 'Usage: cat log | ' . $0 . ' [switches]
    297. 

    298. 

  298. Reports:
    299. 

  299. -a	all	(extracts all reports available,
    300. 

  300. 		 -a equals -D 10 -d 20 -P 60 -r 20 -s -t 20)
    301. 

  301. -d n	domain	(show n Top-level and n second-level destinations,
    302. 

  302. 		 -1 = unlimited)
    303. 

  303. -p type	peak	(measure peak requests)
    304. 

  304. 		old = make old request-peak mesurement
    305. 

  305. 		new = make new request&byte-peak measurement
    306. 

  306. 		(both slow Calamaris significantly down.)
    307. 

  307. -P n	Performance (show throughput data for every n minutes)
    308. 

  308. -r n	requester (show n Requesters, -1 = unlimited)
    309. 

  309. -R n	targets for requester (show n targets for every Requester,
    310. 

  310. 		-1 = unlimited), implies -r (*)
    311. 

  311. -s	status	(show verbose status reports)
    312. 

  312. -t n	type	(show n content-type, n extensions and requested protocols,
    313. 

  313. 		 -1 = unlimited)
    314. 

  314. -D n    Distribution Histogram (shows size-based distribution of requested
    315. 

  315. 		objects, smaller numbers result in more verbose reports.
    316. 

  316. 		choose 2, 10 or 100 for useful output. (You can also play
    317. 

  317. 		with this ;-))
    318. 

  318. 

  319. Input:
    320. 

  320. -z	zero	(no input via stdin)
    321. 

  321. -f type	format	(sets the type of input logfiles)
    322. 

  322. 		auto = tries to guess the input format
    323. 

  323. 		(This is the Default)
    324. 

  324. 		squid = Native-Logfile derived from Squid V1.1.beta26-V2.x
    325. 

  325. 		squid-extended = Native-Logfile with log_mime_hdrs enabled
    326. 

  326. 			derived from Squid V1.1.beta26-V2.x (*)
    327. 

  327. 			or Cisco Content Engines (*)
    328. 

  328. 			or Squid with SmartFilter-patch (*)
    329. 

  329. 		squid-old = Native-Logfile derived from Squid
    330. 

  330. 			V1.1.alpha1-V1.1.beta25
    331. 

  331. 		nc = Squid-style Logfiles derived from NetCache V?? (<5.x)
    332. 

  332. 		its = Logfiles derived from Inktomi Traffic Server
    333. 

  333. 		elff = Extended Logfile Format (i.e Compaq Tasksmart, Novell
    334. 

  334. 			Internet Caching System, NetCache 5.x)
    335. 

  335. 		nse = Netscape Extended-1/2 Logfile Format
    336. 

  336. 

  337. Output: (Default is plain formatted text)
    338. 

  338. -F type	Format	  (output format (comma-seperated list))
    339. 

  339. 		  mail = mail format
    340. 

  340. 		  html = HTML format
    341. 

  341. 		  html-embed = HTML format without HTML-headers
    342. 

  342. 		  unformatted = plain unformatted output
    343. 

  343. -l string logo	  (add this string to the head of the report. works only in
    344. 

  344. 		   combination with -F html)
    345. 

  345. -M string Meta    (includes the given strings in html-<head>. works only in
    346. 

  346. 		   combination with -F html)
    347. 

  347. -H name Host-name (a name for the Output, -H \'lookup\' issues a lookup for
    348. 

  348. 		   the current host)
    349. 

  349. -O	Order	  (changes the sort order in the reports to request size,
    350. 

  350. 		   default is sorting by number of requests)
    351. 

  351. -N n	N-level   (change all 2nd-level-reports to N-level-reports. N can be
    352. 

  352. 		   any number from 2 up. -1 means full report.)
    353. 

  353. -U string Unit    (define the Unit for the Byte-values, else it will be auto)
    354. 

  354. 		   K(ilo), M(ega), G(iga), T(era)
    355. 

  355. -S list Show      (Shows only the defined reports (comma-seperated list) in the
    356. 

  356. 		   specified order.) The following numbers are defined:
    357. 

  357. ';
    358. 

  358. foreach ( 0 .. $#reports ) {
    359. 

  359.   $USAGE .= "\t\t$_\t$reports[$_]\n";
    360. 

  360. }
    361. 

  361. 

  362. $USAGE .=
    363. 

  363. '		(Note: only putting out one report does not speed up Calamaris
    364. 

  364. 		 as the internal operations were done based on the
    365. 

  365. 		 report-switches. Default: Reports are displayed based on
    366. 

  366. 		 activated reports.)
    367. 

  367. 

  368. Caching:
    369. 

  369. -i file	input-file (input-datafile for caching, to add many files separate
    370. 

  370. 		    them with a \':\')
    371. 

  371. -o file	output-file (output-datafile for caching, can be the same as -i)
    372. 

  372. 

  373. Misc:
    374. 

  374. -n	no-lookup (don\'t look IP-Numbers up)
    375. 

  375. -T n	Time	(adjust the Performance-Report in minutes)
    376. 

  376. -c	case	(switch to case-insensitive (useful for extensions-report))
    377. 

  377. -u	user	(use ident information if available) (*)
    378. 

  378. -I t-t  Interval (defines which time-interval should be parsed)
    379. 

  379. 		  t has to be the format yyyymmddhhmmss
    380. 

  380. 		  omitting the beginning or ending is allowed.
    381. 

  381. 

  382. -b n	benchmark (prints a hash-sign (#) to stderr for each n lines
    383. 

  383. 		   processed)
    384. 

  384. -v	verbose (print information what Calamaris is doing. Useful for
    385. 

  385. 		 debugging.)
    386. 

  386. -L	Loop (dumps the generated internal loop to STDERR for debugging.)
    387. 

  387. 

  388. -C	copyright (prints the copyright)
    389. 

  389. -h	help	(prints out this message)
    390. 

  390. -V	Version (prints version-info)
    391. 

  391. 

  392. (*) These options break the privacy of your users. Please read the README
    393. 

  393. on this.';
    394. 

    395. 

  395. print "$USAGE\n\n" if $opt_h;
    396. 

  396. print "$VERSION\n\n" if $opt_V;
    397. 

  397. print "$COPYRIGHT\n\n" if $opt_C or $opt_h or $opt_V;
    398. 

  398. 

  399. exit 0 if $opt_h or $opt_C or $opt_V;
    400. 

  400. 

  401. if ($usage_err) {
    402. 

  402.   print STDERR "run '$0 -h' for help.\n\n";
    403. 

  403.   exit 1;
    404. 

  404. }
    405. 

  405. 

  406. # initialize variables
    407. 

  407. $counter = $hier = $hier_direct = $hier_direct_size = $hier_direct_time =
    408. 

  408.   $hier_parent = $hier_parent_size = $hier_parent_time = $hier_sibling =
    409. 

  409.   $hier_sibling_size = $hier_sibling_time = $hier_size = $hier_time =
    410. 

  410.   $invalid = $peak_all_min = $peak_all_min_time = $peak_all_sec =
    411. 

  411.   $peak_all_sec_time = $peak_all_hour = $peak_all_hour_time = $peak_tcp_min =
    412. 

  412.   $peak_tcp_min_time = $peak_tcp_sec = $peak_tcp_sec_time = $peak_tcp_hour =
    413. 

  413.   $peak_tcp_hour_time = $peak_udp_min = $peak_udp_min_time = $peak_udp_sec =
    414. 

  414.   $peak_udp_sec_time = $peak_udp_hour = $peak_udp_hour_time = $size =
    415. 

  415.   $skipped = $tcp = $tcp_hit = $tcp_hit_size = $tcp_hit_time = $tcp_miss =
    416. 

  416.   $tcp_miss_none = $tcp_miss_none_size = $tcp_miss_none_time =
    417. 

  417.   $tcp_miss_size = $tcp_miss_time = $tcp_size = $tcp_time = $time =
    418. 

  418.   $time_end = $time_run = $udp = $udp_hit = $udp_hit_size = $udp_hit_time =
    419. 

  419.   $udp_miss = $udp_miss_size = $udp_miss_time = $udp_size = $udp_time = 0;
    420. 

  420. $time_begin = 9999999999;
    421. 

  421. @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    422. 

  422. 

  423. ### Read Cache.
    424. 

  424. if ($opt_i) {
    425. 

  425.   foreach $file ( split ':', $opt_i ) {
    426. 

  426.     open( CACHE, "$file" ) or die ("$0: can't open $file for reading: $!\n");
    427. 

  427.     while (<CACHE>) {
    428. 

  428.       chomp;
    429. 

  429.       @cache = split '?';
    430. 

  430.       $x = shift (@cache);
    431. 

  431.       next unless ($x);
    432. 

  432.       if ( $x eq 'A' and $#cache == 39 ) {
    433. 

  433. 	$time_begin = $cache[0] if $cache[0] < $time_begin;
    434. 

  434. 	$time_end = $cache[1] if $cache[1] > $time_end;
    435. 

  435. 	$counter += $cache[2];
    436. 

  436. 	$size += $cache[3];
    437. 

  437. 	$time += $cache[4];
    438. 

  438. 	$invalid += $cache[5];
    439. 

  439. 	$time_run += $cache[6];
    440. 

  440. 	$udp += $cache[7];
    441. 

  441. 	$udp_size += $cache[8];
    442. 

  442. 	$udp_time += $cache[9];
    443. 

  443. 	$udp_hit += $cache[10];
    444. 

  444. 	$udp_hit_size += $cache[11];
    445. 

  445. 	$udp_hit_time += $cache[12];
    446. 

  446. 	$udp_miss += $cache[13];
    447. 

  447. 	$udp_miss_size += $cache[14];
    448. 

  448. 	$udp_miss_time += $cache[15];
    449. 

  449. 	$tcp += $cache[16];
    450. 

  450. 	$tcp_size += $cache[17];
    451. 

  451. 	$tcp_time += $cache[18];
    452. 

  452. 	$tcp_hit += $cache[19];
    453. 

  453. 	$tcp_hit_size += $cache[20];
    454. 

  454. 	$tcp_hit_time += $cache[21];
    455. 

  455. 	$tcp_miss += $cache[22];
    456. 

  456. 	$tcp_miss_size += $cache[23];
    457. 

  457. 	$tcp_miss_time += $cache[24];
    458. 

  458. 	$tcp_miss_none += $cache[25];
    459. 

  459. 	$tcp_miss_none_size += $cache[26];
    460. 

  460. 	$tcp_miss_none_time += $cache[27];
    461. 

  461. 	$hier += $cache[28];
    462. 

  462. 	$hier_size += $cache[29];
    463. 

  463. 	$hier_time += $cache[30];
    464. 

  464. 	$hier_direct += $cache[31];
    465. 

  465. 	$hier_direct_size += $cache[32];
    466. 

  466. 	$hier_direct_time += $cache[33];
    467. 

  467. 	$hier_sibling += $cache[34];
    468. 

  468. 	$hier_sibling_size += $cache[35];
    469. 

  469. 	$hier_sibling_time += $cache[36];
    470. 

  470. 	$hier_parent += $cache[37];
    471. 

  471. 	$hier_parent_size += $cache[38];
    472. 

  472. 	$hier_parent_time += $cache[39];
    473. 

  473.       } elsif ( $x eq 'B' and $#cache == 17 ) {
    474. 

  474. 	unless ( $peak_udp_sec == 0 ) {
    475. 

  475. 	  warn("multiple cache files.\n") if $opt_v;
    476. 

  476. 	  $peak_warn = 'Peak values are possibly wrong!';
    477. 

  477. 	}
    478. 

  478. 	if ( $peak_udp_sec < $cache[0] ) {
    479. 

  479. 	  $peak_udp_sec = $cache[0];
    480. 

  480. 	  $peak_udp_sec_time = $cache[1];
    481. 

  481. 	}
    482. 

  482. 	if ( $peak_udp_min < $cache[2] ) {
    483. 

  483. 	  $peak_udp_min = $cache[2];
    484. 

  484. 	  $peak_udp_min_time = $cache[3];
    485. 

  485. 	}
    486. 

  486. 	$peak_udp_hour{ $cache[5] } = 0
    487. 

  487. 	  unless defined $peak_udp_hour{ $cache[5] };
    488. 

  488. 	$peak_udp_hour{ $cache[5] } += $cache[4];
    489. 

  489. 	if ( $peak_tcp_sec < $cache[6] ) {
    490. 

  490. 	  $peak_tcp_sec = $cache[6];
    491. 

  491. 	  $peak_tcp_sec_time = $cache[7];
    492. 

  492. 	}
    493. 

  493. 	if ( $peak_tcp_min < $cache[8] ) {
    494. 

  494. 	  $peak_tcp_min = $cache[8];
    495. 

  495. 	  $peak_tcp_min_time = $cache[9];
    496. 

  496. 	}
    497. 

  497. 	$peak_tcp_hour{ $cache[11] } = 0
    498. 

  498. 	  unless defined $peak_tcp_hour{ $cache[11] };
    499. 

  499. 	$peak_tcp_hour{ $cache[11] } += $cache[10];
    500. 

  500. 	if ( $peak_all_sec < $cache[12] ) {
    501. 

  501. 	  $peak_all_sec = $cache[12];
    502. 

  502. 	  $peak_all_sec_time = $cache[13];
    503. 

  503. 	}
    504. 

  504. 	if ( $peak_all_min < $cache[14] ) {
    505. 

  505. 	  $peak_all_min = $cache[14];
    506. 

  506. 	  $peak_all_min_time = $cache[15];
    507. 

  507. 	}
    508. 

  508. 	$peak_all_hour{ $cache[17] } = 0
    509. 

  509. 	  unless defined $peak_all_hour{ $cache[17] };
    510. 

  510. 	$peak_all_hour{ $cache[17] } += $cache[16];
    511. 

  511.       } elsif ( $x eq 'B' and $#cache == 23 ) {
    512. 

  512. 	unless ( $peak_udp_sec == 0 ) {
    513. 

  513. 	  warn("multiple cache files.\n") if $opt_v;
    514. 

  514. 	  $peak_warn = 'Peak values are possibly wrong!';
    515. 

  515. 	}
    516. 

  516. 	if ( $peak_udp_sec < $cache[0] ) {
    517. 

  517. 	  $peak_udp_sec = $cache[0];
    518. 

  518. 	  $peak_udp_sec_time = $cache[1];
    519. 

  519. 	}
    520. 

  520. 	if ( $peak_udp_min < $cache[2] ) {
    521. 

  521. 	  $peak_udp_min = $cache[2];
    522. 

  522. 	  $peak_udp_min_time = $cache[3];
    523. 

  523. 	}
    524. 

  524. 	$peak_udp_hour{ $cache[5] } = 0
    525. 

  525. 	  unless defined $peak_udp_hour{ $cache[5] };
    526. 

  526. 	$peak_udp_hour{ $cache[5] } += $cache[4];
    527. 

  527. 	$peak_udp_hour_size{ $cache[7] } = 0
    528. 

  528. 	  unless defined $peak_udp_hour_size{ $cache[7] };
    529. 

  529. 	$peak_udp_hour_size{ $cache[7] } += $cache[6];
    530. 

  530. 	if ( $peak_tcp_sec < $cache[8] ) {
    531. 

  531. 	  $peak_tcp_sec = $cache[8];
    532. 

  532. 	  $peak_tcp_sec_time = $cache[9];
    533. 

  533. 	}
    534. 

  534. 	if ( $peak_tcp_min < $cache[10] ) {
    535. 

  535. 	  $peak_tcp_min = $cache[10];
    536. 

  536. 	  $peak_tcp_min_time = $cache[11];
    537. 

  537. 	}
    538. 

  538. 	$peak_tcp_hour{ $cache[13] } = 0
    539. 

  539. 	  unless defined $peak_tcp_hour{ $cache[13] };
    540. 

  540. 	$peak_tcp_hour{ $cache[13] } += $cache[12];
    541. 

  541. 	$peak_tcp_hour_size{ $cache[15] } = 0
    542. 

  542. 	  unless defined $peak_tcp_hour_size{ $cache[15] };
    543. 

  543. 	$peak_tcp_hour_size{ $cache[15] } += $cache[14];
    544. 

  544. 	if ( $peak_all_sec < $cache[16] ) {
    545. 

  545. 	  $peak_all_sec = $cache[16];
    546. 

  546. 	  $peak_all_sec_time = $cache[17];
    547. 

  547. 	}
    548. 

  548. 	if ( $peak_all_min < $cache[18] ) {
    549. 

  549. 	  $peak_all_min = $cache[18];
    550. 

  550. 	  $peak_all_min_time = $cache[19];
    551. 

  551. 	}
    552. 

  552. 	$peak_all_hour{ $cache[21] } = 0
    553. 

  553. 	  unless defined $peak_all_hour{ $cache[21] };
    554. 

  554. 	$peak_all_hour{ $cache[21] } += $cache[20];
    555. 

  555. 	$peak_all_hour_size{ $cache[23] } = 0
    556. 

  556. 	  unless defined $peak_all_hour_size{ $cache[23] };
    557. 

  557. 	$peak_all_hour_size{ $cache[23] } += $cache[22];
    558. 

  558.       } elsif ( $x eq 'C' and $#cache == 3 ) {
    559. 

  559. 	$y = shift (@cache);
    560. 

  560. 	$method{$y} = $method_size{$y} = $method_time{$y} = 0
    561. 

  561. 	  unless defined $method{$y};
    562. 

  562. 	$method{$y} += $cache[0];
    563. 

  563. 	$method_size{$y} += $cache[1];
    564. 

  564. 	$method_time{$y} += $cache[2];
    565. 

  565.       } elsif ( $x eq 'D' and $#cache == 3 ) {
    566. 

  566. 	$y = shift (@cache);
    567. 

  567. 	$udp_hit{$y} = $udp_hit_size{$y} = $udp_hit_time{$y} = 0
    568. 

  568. 	  unless defined $udp_hit{$y};
    569. 

  569. 	$udp_hit{$y} += $cache[0];
    570. 

  570. 	$udp_hit_size{$y} += $cache[1];
    571. 

  571. 	$udp_hit_time{$y} += $cache[2];
    572. 

  572.       } elsif ( $x eq 'E' and $#cache == 3 ) {
    573. 

  573. 	$y = shift (@cache);
    574. 

  574. 	$udp_miss{$y} = $udp_miss_size{$y} = $udp_miss_time{$y} = 0
    575. 

  575. 	  unless defined $udp_miss{$y};
    576. 

  576. 	$udp_miss{$y} += $cache[0];
    577. 

  577. 	$udp_miss_size{$y} += $cache[1];
    578. 

  578. 	$udp_miss_time{$y} += $cache[2];
    579. 

  579.       } elsif ( $x eq 'F' and $#cache == 3 ) {
    580. 

  580. 	$y = shift (@cache);
    581. 

  581. 	$tcp_hit{$y} = $tcp_hit_size{$y} = $tcp_hit_time{$y} = 0
    582. 

  582. 	  unless defined $tcp_hit{$y};
    583. 

  583. 	$tcp_hit{$y} += $cache[0];
    584. 

  584. 	$tcp_hit_size{$y} += $cache[1];
    585. 

  585. 	$tcp_hit_time{$y} += $cache[2];
    586. 

  586.       } elsif ( $x eq 'G' and $#cache == 3 ) {
    587. 

  587. 	$y = shift (@cache);
    588. 

  588. 	$tcp_miss{$y} = $tcp_miss_size{$y} = $tcp_miss_time{$y} = 0
    589. 

  589. 	  unless defined $tcp_miss{$y};
    590. 

  590. 	$tcp_miss{$y} += $cache[0];
    591. 

  591. 	$tcp_miss_size{$y} += $cache[1];
    592. 

  592. 	$tcp_miss_time{$y} += $cache[2];
    593. 

  593.       } elsif ( $x eq 'H' and $#cache == 3 ) {
    594. 

  594. 	$y = shift (@cache);
    595. 

  595. 	$tcp_miss_none{$y} = $tcp_miss_none_size{$y} =
    596. 

  596. 	  $tcp_miss_none_time{$y} = 0
    597. 

  597. 	  unless defined $tcp_miss_none{$y};
    598. 

  598. 	$tcp_miss_none{$y} += $cache[0];
    599. 

  599. 	$tcp_miss_none_size{$y} += $cache[1];
    600. 

  600. 	$tcp_miss_none_time{$y} += $cache[2];
    601. 

  601.       } elsif ( $x eq 'I' and $#cache == 3 ) {
    602. 

  602. 	$y = shift (@cache);
    603. 

  603. 	$hier_direct{$y} = $hier_direct_size{$y} = $hier_direct_time{$y} = 0
    604. 

  604. 	  unless defined $hier_direct{$y};
    605. 

  605. 	$hier_direct{$y} += $cache[0];
    606. 

  606. 	$hier_direct_size{$y} += $cache[1];
    607. 

  607. 	$hier_direct_time{$y} += $cache[2];
    608. 

  608.       } elsif ( $x eq 'J' and $#cache == 3 ) {
    609. 

  609. 	$y = shift (@cache);
    610. 

  610. 	$hier_sibling{$y} = $hier_sibling_size{$y} = $hier_sibling_time{$y} =
    611. 

  611. 	  0
    612. 

  612. 	  unless defined $hier_sibling{$y};
    613. 

  613. 	$hier_sibling{$y} += $cache[0];
    614. 

  614. 	$hier_sibling_size{$y} += $cache[1];
    615. 

  615. 	$hier_sibling_time{$y} += $cache[2];
    616. 

  616.       } elsif ( $x eq 'K' and $#cache == 3 ) {
    617. 

  617. 	$y = shift (@cache);
    618. 

  618. 	$hier_parent{$y} = $hier_parent_size{$y} = $hier_parent_time{$y} = 0
    619. 

  619. 	  unless defined $hier_parent{$y};
    620. 

  620. 	$hier_parent{$y} += $cache[0];
    621. 

  621. 	$hier_parent_size{$y} += $cache[1];
    622. 

  622. 	$hier_parent_time{$y} += $cache[2];
    623. 

  623.       } elsif ( $x eq 'L' and $#cache == 3 ) {
    624. 

  624. 	$y = shift (@cache);
    625. 

  625. 	$hier_neighbor{$y} = $hier_neighbor_size{$y} =
    626. 

  626. 	  $hier_neighbor_time{$y} = 0
    627. 

  627. 	  unless defined $hier_neighbor{$y};
    628. 

  628. 	$hier_neighbor{$y} += $cache[0];
    629. 

  629. 	$hier_neighbor_size{$y} += $cache[1];
    630. 

  630. 	$hier_neighbor_time{$y} += $cache[2];
    631. 

  631.       } elsif ( $x eq 'M' and $#cache == 4 ) {
    632. 

  632. 	$y = shift (@cache);
    633. 

  633. 	$z = shift (@cache);
    634. 

  634. 	$hier_neighbor_status{$y}{$z} = $hier_neighbor_status_size{$y}{$z} =
    635. 

  635. 	  $hier_neighbor_status_time{$y}{$z} = 0
    636. 

  636. 	  unless defined $hier_neighbor_status{$y}{$z};
    637. 

  637. 	$hier_neighbor_status{$y}{$z} += $cache[0];
    638. 

  638. 	$hier_neighbor_status_size{$y}{$z} += $cache[1];
    639. 

  639. 	$hier_neighbor_status_time{$y}{$z} += $cache[2];
    640. 

  640.       } elsif ( $x eq 'N' and $#cache == 3 ) {
    641. 

  641. 	$y = shift (@cache);
    642. 

  642. 	$tcp_urlhost{$y} = $tcp_urlhost_size{$y} = $tcp_hit_urlhost{$y} = 0
    643. 

  643. 	  unless defined $tcp_urlhost{$y};
    644. 

  644. 	$tcp_urlhost{$y} += $cache[0];
    645. 

  645. 	$tcp_urlhost_size{$y} += $cache[1];
    646. 

  646. 	$tcp_hit_urlhost{$y} += $cache[2];
    647. 

  647.       } elsif ( $x eq 'O' and $#cache == 3 ) {
    648. 

  648. 	$y = shift (@cache);
    649. 

  649. 	$tcp_urltld{$y} = $tcp_urltld_size{$y} = $tcp_hit_urltld{$y} = 0
    650. 

  650. 	  unless defined $tcp_urltld{$y};
    651. 

  651. 	$tcp_urltld{$y} += $cache[0];
    652. 

  652. 	$tcp_urltld_size{$y} += $cache[1];
    653. 

  653. 	$tcp_hit_urltld{$y} += $cache[2];
    654. 

  654.       } elsif ( $x eq 'P' and $#cache == 3 ) {
    655. 

  655. 	$y = shift (@cache);
    656. 

  656. 	$tcp_urlprot{$y} = $tcp_urlprot_size{$y} = $tcp_hit_urlprot{$y} = 0
    657. 

  657. 	  unless defined $tcp_urlprot{$y};
    658. 

  658. 	$tcp_urlprot{$y} += $cache[0];
    659. 

  659. 	$tcp_urlprot_size{$y} += $cache[1];
    660. 

  660. 	$tcp_hit_urlprot{$y} += $cache[2];
    661. 

  661.       } elsif ( $x eq 'Q' and $#cache == 3 ) {
    662. 

  662. 	$y = shift (@cache);
    663. 

  663. 	$tcp_content{$y} = $tcp_content_size{$y} = $tcp_hit_content{$y} = 0
    664. 

  664. 	  unless defined $tcp_content{$y};
    665. 

  665. 	$tcp_content{$y} += $cache[0];
    666. 

  666. 	$tcp_content_size{$y} += $cache[1];
    667. 

  667. 	$tcp_hit_content{$y} += $cache[2];
    668. 

  668.       } elsif ( $x eq 'R' and $#cache == 3 ) {
    669. 

  669. 	$y = shift (@cache);
    670. 

  670. 	$tcp_urlext{$y} = $tcp_urlext_size{$y} = $tcp_hit_urlext{$y} = 0
    671. 

  671. 	  unless defined $tcp_urlext{$y};
    672. 

  672. 	$tcp_urlext{$y} += $cache[0];
    673. 

  673. 	$tcp_urlext_size{$y} += $cache[1];
    674. 

  674. 	$tcp_hit_urlext{$y} += $cache[2];
    675. 

  675.       } elsif ( $x eq 'S' and $#cache == 5 ) {
    676. 

  676. 	$y = shift (@cache);
    677. 

  677. 	$udp_requester{$y} = $udp_requester_size{$y} =
    678. 

  678. 	  $udp_requester_time{$y} = $udp_hit_requester{$y} =
    679. 

  679. 	  $udp_hit_requester_size{$y} = 0
    680. 

  680. 	  unless defined $udp_requester{$y};
    681. 

  681. 	$udp_requester{$y} += $cache[0];
    682. 

  682. 	$udp_requester_size{$y} += $cache[1];
    683. 

  683. 	$udp_requester_time{$y} += $cache[2];
    684. 

  684. 	$udp_hit_requester{$y} += $cache[3];
    685. 

  685. 	$udp_hit_requester_size{$y} += $cache[4];
    686. 

  686.       } elsif ( $x eq 'T' and $#cache == 5 ) {
    687. 

  687. 	$y = shift (@cache);
    688. 

  688. 	$tcp_requester{$y} = $tcp_requester_size{$y} =
    689. 

  689. 	  $tcp_requester_time{$y} = $tcp_hit_requester{$y} =
    690. 

  690. 	  $tcp_hit_requester_size{$y} = 0
    691. 

  691. 	  unless defined $tcp_requester{$y};
    692. 

  692. 	$tcp_requester{$y} += $cache[0];
    693. 

  693. 	$tcp_requester_size{$y} += $cache[1];
    694. 

  694. 	$tcp_requester_time{$y} += $cache[2];
    695. 

  695. 	$tcp_hit_requester{$y} += $cache[3];
    696. 

  696. 	$tcp_hit_requester_size{$y} += $cache[4];
    697. 

  697.       } elsif ( $x eq 'U' and $#cache == 13 ) {
    698. 

  698. 	$y = shift (@cache);
    699. 

  699. 	( $perf_counter{$y}, $perf_size{$y}, $perf_time{$y},
    700. 

  700. 	 $perf_tcp_hit_size{$y}, $perf_tcp_hit_time{$y},
    701. 

  701. 	 $perf_tcp_miss_size{$y}, $perf_tcp_miss_time{$y},
    702. 

  702. 	 $perf_hier_direct_size{$y}, $perf_hier_direct_time{$y},
    703. 

  703. 	 $perf_hier_sibling_size{$y}, $perf_hier_sibling_time{$y},
    704. 

  704. 	 $perf_hier_parent_size{$y}, $perf_hier_parent_time{$y} )
    705. 

  705. 	  = @cache;
    706. 

  706. # This is for a stupid bug I brought in... it should save older Cache-Files,
    707. 

  707. # and put them in so that we can work with them.. remove at end of 2003
    708. 

  708.       } elsif ( $x eq 'U' and $#cache == 12 ) {
    709. 

  709. 	$cache_warn1 = 'The Performance data misses the Cache-Hits-value';
    710. 

  710. 	$y = shift (@cache);
    711. 

  711. 	( $perf_counter{$y}, $perf_size{$y}, $perf_time{$y},
    712. 

  712. 	 $perf_tcp_hit_size{$y}, $perf_tcp_miss_size{$y},
    713. 

  713. 	 $perf_tcp_miss_time{$y}, $perf_hier_direct_size{$y},
    714. 

  714. 	 $perf_hier_direct_time{$y}, $perf_hier_sibling_size{$y},
    715. 

  715. 	 $perf_hier_sibling_time{$y}, $perf_hier_parent_size{$y},
    716. 

  716. 	 $perf_hier_parent_time{$y} )
    717. 

  717. 	  = @cache;
    718. 

  718. # stupid, yes...
    719. 

  719. # I set this to 0/.000001 so removezerotime prints a - in the report.
    720. 

  720. 	$perf_tcp_hit_size{$y} = 0;
    721. 

  721. 	$perf_tcp_hit_time{$y} = .000001;
    722. 

  722. # End of stupid bug-workaround
    723. 

  723.       } elsif ( $x eq 'V' and $#cache == 6 ) {
    724. 

  724. 	$y = shift (@cache);
    725. 

  725. 	$z = shift (@cache);
    726. 

  726. 	$udp_requester_urlhost{$y}{$z} = $udp_requester_urlhost_size{$y}{$z} =
    727. 

  727. 	  $udp_requester_urlhost_time{$y}{$z} =
    728. 

  728. 	  $udp_hit_requester_urlhost{$y}{$z} =
    729. 

  729. 	  $udp_hit_requester_urlhost_size{$y}{$z} = 0
    730. 

  730. 	  unless defined $udp_requester_urlhost{$y}{$z};
    731. 

  731. 	$udp_requester_urlhost{$y}{$z} += $cache[0];
    732. 

  732. 	$udp_requester_urlhost_size{$y}{$z} += $cache[1];
    733. 

  733. 	$udp_requester_urlhost_time{$y}{$z} += $cache[2];
    734. 

  734. 	$udp_hit_requester_urlhost{$y}{$z} += $cache[3];
    735. 

  735. 	$udp_hit_requester_urlhost_size{$y}{$z} += $cache[4];
    736. 

  736. # Start of Bug-fix - remove this at end of 2003
    737. 

  737.       } elsif ( $x eq 'V' and $#cache == 5 ) {
    738. 

  738. 	$cache_warn2 = 'The UDP-Requester-Report misses the other-value';
    739. 

  739. 	$y = '<other>' unless ($y);
    740. 

  740. 	$z = shift (@cache);
    741. 

  741. 	$udp_requester_urlhost{$y}{$z} = $udp_requester_urlhost_size{$y}{$z} =
    742. 

  742. 	  $udp_requester_urlhost_time{$y}{$z} =
    743. 

  743. 	  $udp_hit_requester_urlhost{$y}{$z} =
    744. 

  744. 	  $udp_hit_requester_urlhost_size{$y}{$z} = 0
    745. 

  745. 	  unless defined $udp_requester_urlhost{$y}{$z};
    746. 

  746. 	$udp_requester_urlhost{$y}{$z} += $cache[0];
    747. 

  747. 	$udp_requester_urlhost_size{$y}{$z} += $cache[1];
    748. 

  748. 	$udp_requester_urlhost_time{$y}{$z} += $cache[2];
    749. 

  749. 	$udp_hit_requester_urlhost{$y}{$z} += $cache[3];
    750. 

  750. 	$udp_hit_requester_urlhost_size{$y}{$z} += $cache[4];
    751. 

  751. # End of Bug-fix
    752. 

  752.       } elsif ( $x eq 'W' and $#cache == 6 ) {
    753. 

  753. 	$y = shift (@cache);
    754. 

  754. 	$z = shift (@cache);
    755. 

  755. 	$tcp_requester_urlhost{$y}{$z} = $tcp_requester_urlhost_size{$y}{$z} =
    756. 

  756. 	  $tcp_requester_urlhost_time{$y}{$z} =
    757. 

  757. 	  $tcp_hit_requester_urlhost{$y}{$z} =
    758. 

  758. 	  $tcp_hit_requester_urlhost_size{$y}{$z} = 0
    759. 

  759. 	  unless defined $tcp_requester_urlhost{$y}{$z};
    760. 

  760. 	$tcp_requester_urlhost{$y}{$z} += $cache[0];
    761. 

  761. 	$tcp_requester_urlhost_size{$y}{$z} += $cache[1];
    762. 

  762. 	$tcp_requester_urlhost_time{$y}{$z} += $cache[2];
    763. 

  763. 	$tcp_hit_requester_urlhost{$y}{$z} += $cache[3];
    764. 

  764. 	$tcp_hit_requester_urlhost_size{$y}{$z} += $cache[4];
    765. 

  765. # Start of Bugfix - remove at end of 2003
    766. 

  766.       } elsif ( $x eq 'W' and $#cache == 5 ) {
    767. 

  767. 	$cache_warn3 = 'The TCP-Requester-Report misses the other-value';
    768. 

  768. 	$y = '<other>' unless ($y);
    769. 

  769. 	$z = shift (@cache);
    770. 

  770. 	$tcp_requester_urlhost{$y}{$z} = $tcp_requester_urlhost_size{$y}{$z} =
    771. 

  771. 	  $tcp_requester_urlhost_time{$y}{$z} =
    772. 

  772. 	  $tcp_hit_requester_urlhost{$y}{$z} =
    773. 

  773. 	  $tcp_hit_requester_urlhost_size{$y}{$z} = 0
    774. 

  774. 	  unless defined $tcp_requester_urlhost{$y}{$z};
    775. 

  775. 	$tcp_requester_urlhost{$y}{$z} += $cache[0];
    776. 

  776. 	$tcp_requester_urlhost_size{$y}{$z} += $cache[1];
    777. 

  777. 	$tcp_requester_urlhost_time{$y}{$z} += $cache[2];
    778. 

  778. 	$tcp_hit_requester_urlhost{$y}{$z} += $cache[3];
    779. 

  779. 	$tcp_hit_requester_urlhost_size{$y}{$z} += $cache[4];
    780. 

  780. # End of Bugfix
    781. 

  781.       } elsif ( $x eq 'X' and $#cache == 5 ) {
    782. 

  782. 	$y = shift (@cache);
    783. 

  783. 	$tcp_distribution{$y} = $tcp_distribution_size{$y} =
    784. 

  784. 	  $tcp_distribution_time{$y} = $tcp_hit_distribution{$y} =
    785. 

  785. 	  $tcp_hit_distribution_size{$y} = 0
    786. 

  786. 	  unless defined $tcp_distribution{$y};
    787. 

  787. 	$tcp_distribution{$y} += $cache[0];
    788. 

  788. 	$tcp_distribution_size{$y} += $cache[1];
    789. 

  789. 	$tcp_distribution_time{$y} += $cache[2];
    790. 

  790. 	$tcp_hit_distribution{$y} += $cache[3];
    791. 

  791. 	$tcp_hit_distribution_size{$y} += $cache[4];
    792. 

  792.       } else {
    793. 

  793. 	print STDERR "can't parse cache-line: \"$x @cache\"\n";
    794. 

  794.       }
    795. 

  795.     }
    796. 

  796.     close(CACHE);
    797. 

  797.   }
    798. 

  798. }
    799. 

  799. 

  800. unless ($opt_z) {
    801. 

  801.   while ( defined( $line = <> ) ) {
    802. 

  802.     if ( not defined $opt_f or $opt_f eq 'auto' ) {
    803. 

  803.       if ( $line =~
    804. 

  804. 	  m#^\d+\.\d+\s+\d+\s+[\w\-\.:]+\s+\w+/\d+\s+\d+\s+\w+\s+\S+\s+\S+\s+\w+/\S+\s+\S+$#
    805. 

  805. 	  )
    806. 

  806.       {
    807. 

  807. 	$opt_f = 'squid';
    808. 

  808. 	print STDERR "guessing... using '-f squid'\n" if ($opt_v);
    809. 

  809. 	last;
    810. 

  810.       } elsif ( $line =~
    811. 

  811. 	       m#^\d+\s+\d+\s+[\w\-\.:]+\s+\w+/\d+\s+\d+\s+\w+\s+\S+\s+\S+\s+\w+/\S+\s+\S+$#
    812. 

  812. 	       )
    813. 

  813.       {
    814. 

  814. 	$opt_f = 'its';
    815. 

  815. 	print STDERR "guessing... using '-f its'\n" if ($opt_v);
    816. 

  816. 	last;
    817. 

  817.       } elsif ( $line =~
    818. 

  818. 	       m#^\d+\.\d+\s+\d+\s+[\w\-\.:]+\s+\w+/\d+\s+\d+\s+\w+\s+\S+\s+\S+\s+\w+/\S+$#
    819. 

  819. 	       )
    820. 

  820.       {
    821. 

  821. 	$opt_f = 'squid-old';
    822. 

  822. 	print STDERR "guessing... using '-f squid-old'\n" if ($opt_v);
    823. 

  823. 	last;
    824. 

  824.       } elsif ( $line =~
    825. 

  825. 	       m#^\d+\.\d+\s+\d+\s+[\w\-\.:]+\s+\w+/\d+\s+\d+\s+\w+\s+\S+\s+\S+\s+\w+/\S+\s+(\S|; c)+\s+\S+$#
    826. 

  826. 	       )
    827. 

  827.       {
    828. 

  828. 	$opt_f = 'nc';
    829. 

  829. 	print STDERR "guessing... using '-f nc'\n" if ($opt_v);
    830. 

  830. 	last;
    831. 

  831.       } elsif ( $line =~ s/^\s*#\s*Fields:\s*// ) {
    832. 

  832. 	$opt_f = 'elff';
    833. 

  833. 	print STDERR "guessing... using '-f elff'\n" if ($opt_v);
    834. 

  834. 	last;
    835. 

  835.       } elsif ( $line =~ s/^\s*format=\s*// ) {
    836. 

  836. 	$opt_f = 'nse';
    837. 

  837. 	print STDERR "guessing... using '-f nse'\n" if ($opt_v);
    838. 

  838. 	last;
    839. 

  839.       } elsif ( $line =~
    840. 

  840. 	       m#^\d+\.\d+\s+\d+\s+[\w\-\.:]+\s+\w+/\-?\d+\s+\d+\s+\w+\s+\S+\s+\S+\s+\w+/\S+\s+\S+\s+#
    841. 

  841. 	       )
    842. 

  842.       {
    843. 

  843. 	$opt_f = 'squid-extended';
    844. 

  844. 	print STDERR "guessing... using '-f squid-extended'\n" if ($opt_v);
    845. 

  845. 	last;
    846. 

  846.       } elsif ( $line =~
    847. 

  847. 	       m#^[\w\-\.:]+\s+\S+\s+\S+\s+\[.+\]\s+\"\w+\s+\S+\s+\S+\"\s+\d+\s+\d+\s+\S+(\s+\[.*\]\s+\[.*\])?$#
    848. 

  848. 	       )
    849. 

  849.       {
    850. 

  850. 	print STDERR "$0: The first line of the input looks to me as if you
    851. 

  851. switched 'emulate_httpd_log' to on. I can't parse that format. Please read
    852. 

  852. the README on this.\n\n";
    853. 

  853. 	exit(1);
    854. 

  854.       } elsif ( $line =~ m/^\s*(#|$)/ ) {
    855. 

  855. 	print STDERR "skipping: $line\n" if ($opt_v);
    856. 

  856. 	next;
    857. 

  857.       } else {
    858. 

  858. 	print STDERR "$0: I don't know this input format. Please check the
    859. 

  859. input. If you\'re sure that the following line is NOT corrupt and the error
    860. 

  860. also occurs with the recent version of Calamaris (see the README for pointers
    861. 

  861. and known bugs) then report it with the following line to
    862. 

  862. <Calamaris-bug\@Cord.de>. Thank You.\n\n$line\n\n";
    863. 

  863. 	exit(1);
    864. 

  864.       }
    865. 

  865.     } else {
    866. 

  866.       last;
    867. 

  867.     }
    868. 

  868.   }
    869. 

  869.   if ( not defined $opt_f or $opt_f eq 'auto' ) {
    870. 

  870.     print "\nno requests found\n";
    871. 

  871.     exit(0);
    872. 

  872.   }
    873. 

  873.   print STDERR "print a hash-sign for each $opt_b lines:\n" if ($opt_b);
    874. 

  874.   $loop = '
    875. 

  875. for ( ; $line ; $line = <> ) {';
    876. 

  876.   if ( $opt_f eq 'squid' ) {
    877. 

  877.     $loop .= '
    878. 

  878.   ( $log_date, $log_reqtime, $log_requester, $log_status, $log_size,
    879. 

  879.    $log_method, $log_url, $log_ident, $log_hier, $log_content, $foo )
    880. 

  880.     = split ( /\s+/, $line );
    881. 

  881.   if ( not defined $foo
    882. 

  882.       or not defined $log_content
    883. 

  883.       or $foo ne \'\'
    884. 

  884.       or $log_content eq \'\'
    885. 

  885.       or $log_reqtime < 0
    886. 

  886.       or $log_date !~ m#^\d+\.\d{3}$# )
    887. 

  887.   {';
    888. 

  888.   } elsif ( $opt_f eq 'squid-extended' ) {
    889. 

  889.     $loop .= '
    890. 

  890.   $line =~ s/ \[[^\[\]]*\]//g;
    891. 

  891.   ( $log_date, $log_reqtime, $log_requester, $log_status, $log_size,
    892. 

  892.    $log_method, $log_url, $log_ident, $log_hier, $log_content)
    893. 

  893.     = split ( /\s+/, $line, 10 );
    894. 

  894.   chomp($log_content);
    895. 

  895.   if ( not defined $log_content
    896. 

  896.       or $log_content eq \'\'
    897. 

  897.       or $log_reqtime < 0
    898. 

  898.       or $log_date !~ m#^\d+\.\d{3}$# )
    899. 

  899.   {';
    900. 

  900.   } elsif ( $opt_f eq 'its' ) {
    901. 

  901.     $loop .= '
    902. 

  902.   ( $log_date, $log_reqtime, $log_requester, $log_status, $log_size,
    903. 

  903.    $log_method, $log_url, $log_ident, $log_hier, $log_content, $foo ) =
    904. 

  904.     split ( /\s+/, $line );
    905. 

  905.   if ( not defined $foo
    906. 

  906.       or not defined $log_content
    907. 

  907.       or $foo ne \'\'
    908. 

  908.       or $log_content eq \'\'
    909. 

  909.       or $log_reqtime < 0
    910. 

  910.       or $log_date !~ m#^\d+$# )
    911. 

  911. 	{';
    912. 

  912.   } elsif ( $opt_f eq 'squid-old' ) {
    913. 

  913.     $loop .= '
    914. 

  914.   ( $log_date, $log_reqtime, $log_requester, $log_status, $log_size,
    915. 

  915.    $log_method, $log_url, $log_ident, $log_hier, $foo )
    916. 

  916.     = split ( /\s+/, $line );
    917. 

  917.   unless ( not defined $foo
    918. 

  918. 	  or not defined $log_hier
    919. 

  919. 	  or $foo ne \'\'
    920. 

  920. 	  or $log_hier eq \'\'
    921. 

  921. 	  or $log_reqtime < 0
    922. 

  922. 	  or $log_date !~ m#^\d+\.\d{3}$# )
    923. 

  923. 	  {';
    924. 

  924.   } elsif ( $opt_f eq 'nc' ) {
    925. 

  925.     $loop .= '
    926. 

  926.   $line =~ s#\; c#\;_c#og; # Hack to handle buggy logfiles of NetCache V3.2.x
    927. 

  927.   ( $log_date, $log_reqtime, $log_requester, $log_status, $log_size,
    928. 

  928.    $log_method, $log_url, $log_ident, $log_hier, $log_content, $log_abort,
    929. 

  929.    $foo )
    930. 

  930.     = split ( /\s+/, $line );
    931. 

  931.   if ( not defined $foo or not defined $log_abort or $foo ne \'\' or
    932. 

  932.       $log_abort eq \'\' or $log_reqtime < 0 or
    933. 

  933.       $log_date !~ m#^\d+\.\d{3}$# )
    934. 

  934. 	    {';
    935. 

  935.   } elsif ( $opt_f eq 'elff' ) {
    936. 

  936.     @fields = split ( /\s+/, $line );
    937. 

  937.     $loop .= '
    938. 

  938.   use Time::Local;
    939. 

  939.   if ( $line =~
    940. 

  940.       m#^';
    941. 

  941.     foreach (@fields) {
    942. 

  942.       $tmpline1 .= '\s+' if ($tmpline1);
    943. 

  943.       if ( $_ eq 'date' ) {
    944. 

  944. 	$tmpline1 .= '(\d+)-(\d+)-(\d+)';
    945. 

  945. 	$tmpline2 .= '
    946. 

  946.     $log_year = $' . ++$offset . ';
    947. 

  947.     $log_month = $' . ++$offset . ';
    948. 

  948.     $log_day = $' . ++$offset . ';';
    949. 

  949.       } elsif ( $_ eq 'time' ) {
    950. 

  950. 	$tmpline1 .= '(\d+):(\d+):(\d+)';
    951. 

  951. 	$tmpline2 .= '
    952. 

  952.     $log_hour = $' . ++$offset . ';
    953. 

  953.     $log_min = $' . ++$offset . ';
    954. 

  954.     $log_sec = $' . ++$offset . ';';
    955. 

  955.       } elsif ( $_ eq 'x-timestamp' ) {
    956. 

  956. 	$tmpline1 .= '(\d+\.\d+)';
    957. 

  957. 	$tmpline2 .= '
    958. 

  958.     $log_date = $' . ++$offset . ';';
    959. 

  959. 	$log_date = 0;
    960. 

  960.       } elsif ( $_ eq 'c-ip' ) {
    961. 

  961. 	$tmpline1 .= '([\w\-\.:]+)';
    962. 

  962. 	$tmpline2 .= '
    963. 

  963.     $log_requester = $' . ++$offset . ';';
    964. 

  964.       } elsif ( $_ eq 'cs-authname'
    965. 

  965. 	       or $_ eq 'x-remote-id'
    966. 

  966. 	       or $_ eq 'x-username'
    967. 

  967. 	       or $_ eq 'cs-username' )
    968. 

  968.       {
    969. 

  969. 	$tmpline1 .= '(\S+)';
    970. 

  970. 	$tmpline2 .= '
    971. 

  971.     $log_ident = $' . ++$offset . ';';
    972. 

  972.       } elsif ( $_ eq 's-ip' or $_ eq 's-sitename' ) {
    973. 

  973. 	$tmpline1 .= '[\w\-\.]+';
    974. 

  974.       } elsif ( $_ eq 'cs-method' ) {
    975. 

  975. 	$tmpline1 .= '([\w\-]+)';
    976. 

  976. 	$tmpline2 .= '
    977. 

  977.     $log_method = $' . ++$offset . ';';
    978. 

  978.       } elsif ( $_ eq 'cs-uri' ) {
    979. 

  979. 	$tmpline1 .= '(\S+)';
    980. 

  980. 	$tmpline2 .= '
    981. 

  981.     $log_url = $' . ++$offset . ';';
    982. 

  982.       } elsif ( $_ eq 'cs-uri-stem'
    983. 

  983. 	       or $_ eq 'cs-uri-query'
    984. 

  984. 	       or $_ eq 'x-note' )
    985. 

  985.       {
    986. 

  986. 	$tmpline1 .= '\S+';
    987. 

  987.       } elsif ( $_ eq 'c-version' ) {
    988. 

  988. 	$tmpline1 .= '\w+/[\d\.]+';
    989. 

  989.       } elsif ( $_ eq 'sc-status' ) {
    990. 

  990. 	$tmpline1 .= '(\d+)';
    991. 

  991. 	$tmpline2 .= '
    992. 

  992.     $log_code = $' . ++$offset . ';';
    993. 

  993.       } elsif ( $_ eq 'sc-bytes' or $_ eq 'bytes' ) {
    994. 

  994. 	$tmpline1 .= '(\d+)';
    995. 

  995. 	$tmpline2 .= '
    996. 

  996.     $log_size = $' . ++$offset . ';';
    997. 

  997.       } elsif ( $_ eq 'cs-bytes' ) {
    998. 

  998. 	$tmpline1 .= '\d+';
    999. 

  999.       } elsif ( $_ eq 'x-elapsed-milliseconds' ) {
    1000. 

  1000. 	$tmpline1 .= '(\d+)';
    1001. 

  1001. 	$tmpline2 .= '
    1002. 

  1002.     $log_reqtime = $' . ++$offset . ';';
    1003. 

  1003.       } elsif ( $_ eq 'time-taken' ) {
    1004. 

  1004. 	$tmpline1 .= '([\d\.]+)';
    1005. 

  1005. 	$tmpline2 .= '
    1006. 

  1006.     $log_reqtime = $' . ++$offset . ' * 1000;';
    1007. 

  1007.       } elsif ( $_ eq 'cs(User-Agent)'
    1008. 

  1008. 	       or $_ eq 'cs(Cookie)'
    1009. 

  1009. 	       or $_ eq 'cs(Referer)'
    1010. 

  1010. 	       or $_ eq 'sc(Referer)'
    1011. 

  1011. 	       or $_ eq 'cs(X-Forwarded-For)'
    1012. 

  1012. 	       or $_ eq 'x-hiername' )
    1013. 

  1013.       {
    1014. 

  1014. 	$tmpline1 .= '(\"[^\"]*\"|-)';
    1015. 

  1015. 	$tmpline2 .= '
    1016. 

  1016.     ++$offset;';
    1017. 

  1017.       } elsif ( $_ eq 'cached' ) {
    1018. 

  1018. 	$tmpline1 .= '(\d+)';
    1019. 

  1019. 	$tmpline2 .= '
    1020. 

  1020.     $log_cached = $' . ++$offset . ';';
    1021. 

  1021.       } elsif ( $_ eq 'x-transaction' ) {
    1022. 

  1022. 	$tmpline1 .= '(\w+\/[\d\-]+)';
    1023. 

  1023. 	$tmpline2 .= '
    1024. 

  1024.     $log_status = $' . ++$offset . ';';
    1025. 

  1025. 	$log_status = 0;
    1026. 

  1026.       } elsif ( $_ eq 'x-fill-proxy-ip' ) {
    1027. 

  1027. 	$tmpline1 .= '([\w\-\.]+)';
    1028. 

  1028. 	$tmpline2 .= '
    1029. 

  1029.     $log_proxy_ip = $' . ++$offset . ';';
    1030. 

  1030.       } elsif ( $_ eq 'x-origin-ip' ) {
    1031. 

  1031. 	$tmpline1 .= '([\w\-\.]+)';
    1032. 

  1032. 	$tmpline2 .= '
    1033. 

  1033.     $log_origin_ip = $' . ++$offset . ';';
    1034. 

  1034.       } elsif ( $_ eq 'x-hiercode' ) {
    1035. 

  1035. 	$tmpline1 .= '([\w\-\.\/]+)';
    1036. 

  1036. 	$tmpline2 .= '
    1037. 

  1037.     $log_hier = $' . ++$offset . ';';
    1038. 

  1038. 	$log_hier = 0;
    1039. 

  1039.       } elsif ( $_ eq 'rs(Content-Type)' ) {
    1040. 

  1040. 	$tmpline1 .= '\"[^\"]*\"';
    1041. 

  1041.       } else {
    1042. 

  1042. 	print STDERR "$0: I don't know this input format. Please check the
    1043. 

  1043. input. If you\'re sure that the following is NOT corrupt and the error also
    1044. 

  1044. occurs with the recent version of Calamaris (see the README for pointers and
    1045. 

  1045. known bugs) then report it with the following line to <Calamaris-bug\@Cord.de>.
    1046. 

  1046. Thank You.\n\n$_\n\n";
    1047. 

  1047. 	exit(1);
    1048. 

  1048.       }
    1049. 

  1049.     }
    1050. 

  1050.     foreach $pattern ( qw(date time c-ip cs-method cs-uri sc-status sc-bytes
    1051. 

  1051. 			  time-taken cached x-fill-proxy-ip x-origin-ip)
    1052. 

  1052. 		      )
    1053. 

  1053.     {
    1054. 

  1054.       unless ( grep $pattern, @fields ) {
    1055. 

  1055. 	print STDERR "$0: Your input file format is missing at least the field
    1056. 

  1056. \'$pattern\'. I can\'t parse it. Sorry. If you think that this field isn't
    1057. 

  1057. important to you, please report this error to <Calamaris-bug\@Cord.de>.
    1058. 

  1058. Thank You.\n\n";
    1059. 

  1059. 	exit(1);
    1060. 

  1060.       }
    1061. 

  1061.     }
    1062. 

  1062.     foreach $pattern (qw(cs-authname)) {
    1063. 

  1063.       unless ( grep $pattern, @fields ) {
    1064. 

  1064. 	if ( $pattern eq 'cs-authname' ) {
    1065. 

  1065. 	  $tmpline2 .= '
    1066. 

  1066.   $log_ident = "-";';
    1067. 

  1067. 	}
    1068. 

  1068.       }
    1069. 

  1069.     }
    1070. 

  1070.     $loop .= $tmpline1 . '.?$#
    1071. 

  1071.     )
    1072. 

  1072.   {' . $tmpline2;
    1073. 

  1073.     $loop .= '
    1074. 

  1074.     $log_date = timegm(
    1075. 

  1075. 		     $log_sec, $log_min, $log_hour, $log_day, $log_month - 1,
    1076. 

  1076. 		     $log_year - 1900
    1077. 

  1077. 		     );' unless defined $log_date;
    1078. 

  1078.     $loop .= '
    1079. 

  1079.     $log_status = "$log_cached/$log_code";' unless defined $log_status;
    1080. 

  1080.     $loop .= '
    1081. 

  1081.     if ( $log_origin_ip ne \'-\' ) {
    1082. 

  1082.       $log_hier = "DIRECT/$log_origin_ip";
    1083. 

  1083.     } elsif ( $log_proxy_ip ne \'-\' ) {
    1084. 

  1084.       if ( $log_cached eq \'0\' ) {
    1085. 

  1085. 	$log_hier = "PARENT_MISS/$log_proxy_ip";
    1086. 

  1086.       } else {
    1087. 

  1087. 	$log_hier = "PARENT_HIT/$log_proxy_ip";
    1088. 

  1088.       }
    1089. 

  1089.     } else {
    1090. 

  1090.       $log_hier = "NONE/-";
    1091. 

  1091.     }' unless defined $log_hier;
    1092. 

  1092.     $loop .= '
    1093. 

  1093.   } else {';
    1094. 

  1094.     while ( defined( $line = <> ) ) {
    1095. 

  1095.       last unless $line =~ /^\s*#/;
    1096. 

  1096.     }
    1097. 

  1097.   } elsif ( $opt_f eq 'nse' ) {
    1098. 

  1098.     $line =~ s#^format=##og;
    1099. 

  1099.     @fields = split ( /\s+/, $line );
    1100. 

  1100.     $loop .= '
    1101. 

  1101.   use Time::Local;
    1102. 

  1102.   if ( $line =~
    1103. 

  1103.     m#^';
    1104. 

  1104.     foreach (@fields) {
    1105. 

  1105.       $tmpline1 .= '\s+' if ($tmpline1);
    1106. 

  1106.       if ( $_ eq '[%SYSDATE%]' ) {
    1107. 

  1107. 	$tmpline1 .= '\[(\d+)/(\w+)/(\d+):(\d+):(\d+):(\d+)\s+\S+\]';
    1108. 

  1108. 	$tmpline2 .= '
    1109. 

  1109.     $log_day = $' . ++$offset . ';
    1110. 

  1110.     $log_month = $' . ++$offset . ';
    1111. 

  1111.     $log_year = $' . ++$offset . ';
    1112. 

  1112.     $log_hour = $' . ++$offset . ';
    1113. 

  1113.     $log_min = $' . ++$offset . ';
    1114. 

  1114.     $log_sec = $' . ++$offset . ';';
    1115. 

  1115.       } elsif ( $_ eq '%Ses->client.ip%' ) {
    1116. 

  1116. 	$tmpline1 .= '([\w\-\.:]+)';
    1117. 

  1117. 	$tmpline2 .= '
    1118. 

  1118.     $log_requester = $' . ++$offset . ';';
    1119. 

  1119.       } elsif ( $_ eq '%Req->vars.pauth-user%' ) {
    1120. 

  1120. 	$tmpline1 .= '(\S+)';
    1121. 

  1121. 	$tmpline2 .= '
    1122. 

  1122.     $log_ident = $' . ++$offset . ';';
    1123. 

  1123.       } elsif ( $_ eq '%Req->vars.remote-status%'
    1124. 

  1124. 	       or $_ eq '%Req->vars.r2p-cl%'
    1125. 

  1125. 	       or $_ eq '%Req->vars.cli-status%'
    1126. 

  1126. 	       or $_ eq '%Req->vars.svr-status%'
    1127. 

  1127. 	       or $_ eq '%Req->vars.cch-status%' )
    1128. 

  1128.       {
    1129. 

  1129. 	$tmpline1 .= '[\w\-\.]+';
    1130. 

  1130.       } elsif ( $_ eq '"%Req->reqpb.proxy-request%"' ) {
    1131. 

  1131. 	$tmpline1 .= '\"(\w+)\s+([^\"]+)\s+\S+\"';
    1132. 

  1132. 	$tmpline2 .= '
    1133. 

  1133.     $log_method = $' . ++$offset . ';
    1134. 

  1134.     $log_url = $' . ++$offset . ';';
    1135. 

  1135.       } elsif ( $_ eq '%Req->srvhdrs.clf-status%' ) {
    1136. 

  1136. 	$tmpline1 .= '([\d\-]+)';
    1137. 

  1137. 	$tmpline2 .= '
    1138. 

  1138.     $log_code = $' . ++$offset . ';';
    1139. 

  1139.       } elsif ( $_ eq '%Req->vars.p2c-cl%' ) {
    1140. 

  1140. 	$tmpline1 .= '([\d\-]+)';
    1141. 

  1141. 	$tmpline2 .= '
    1142. 

  1142.     $log_size = $' . ++$offset . ';';
    1143. 

  1143.       } elsif ( $_ eq '%Req->headers.content-length%'
    1144. 

  1144. 	       or $_ eq '%Req->vars.p2r-cl%'
    1145. 

  1145. 	       or $_ eq '%Req->vars.c2p-hl%'
    1146. 

  1146. 	       or $_ eq '%Req->vars.p2c-hl%'
    1147. 

  1147. 	       or $_ eq '%Req->vars.p2r-hl%'
    1148. 

  1148. 	       or $_ eq '%Req->vars.r2p-hl%' )
    1149. 

  1149.       {
    1150. 

  1150. 	$tmpline1 .= '[\d\-]+';
    1151. 

  1151.       } elsif ( $_ eq '%Req->vars.xfer-time%' ) {
    1152. 

  1152. 	$tmpline1 .= '([\d\.]+)';
    1153. 

  1153. 	$tmpline2 .= '
    1154. 

  1154.     $log_reqtime = $' . ++$offset . ' * 1000;';
    1155. 

  1155.       } elsif ( $_ eq '%route%' ) {
    1156. 

  1156. 	$tmpline1 .= '(\d+)';
    1157. 

  1157. 	$tmpline2 .= '
    1158. 

  1158.     $log_cached = $' . ++$offset . ';';
    1159. 

  1159.       } elsif ( $_ eq '%Req->vars.actual-route%' ) {
    1160. 

  1160. 	$tmpline1 .= '(\S+)';
    1161. 

  1161. 	$tmpline2 .= '
    1162. 

  1162.     $log_hier = $' . ++$offset . ';
    1163. 

  1163.     if ( $log_hier =~ m#[\(\)]# ) {
    1164. 

  1164.       $log_hier =~ s#^(\w+)(\((\S+)\))?$#$1/$3#;
    1165. 

  1165.       $log_status = \'TCP_MISS/-\';
    1166. 

  1166.     } elsif ( $log_hier =~ m#-# ) {
    1167. 

  1167.       $log_hier = $log_hier . \'/-\';
    1168. 

  1168.       $log_status = \'TCP_HIT/-\';
    1169. 

  1169.     } else {
    1170. 

  1170.       $log_hier = $log_hier . \'/-\';
    1171. 

  1171.       $log_status = \'TCP_MISS/-\';
    1172. 

  1172.     }';
    1173. 

  1173.       } elsif ( $_ eq '-' ) {
    1174. 

  1174. 	$tmpline1 .= '-';
    1175. 

  1175.       } else {
    1176. 

  1176. 	print STDERR "$0: I don't know this input format. Please check the
    1177. 

  1177. input. If you\'re sure that the following is NOT corrupt and the error also
    1178. 

  1178. occurs with the recent version of Calamaris (see the README for pointers and
    1179. 

  1179. known bugs) then report it with the following line to <Calamaris-bug\@Cord.de>.
    1180. 

  1180. Thank You.\n\n$_\n\n";
    1181. 

  1181. 	exit(1);
    1182. 

  1182.       }
    1183. 

  1183.     }
    1184. 

  1184.     foreach $pattern ( qw(%Ses->client.ip% [%SYSDATE%]
    1185. 

  1185. 			  %Req->reqpb.proxy-request% %Req->srvhdrs.clf-status%
    1186. 

  1186. 			  %Req->vars.p2c-cl% %Req->vars.xfer-time%)
    1187. 

  1187. 		      )
    1188. 

  1188.     {
    1189. 

  1189.       unless ( grep $pattern, @fields ) {
    1190. 

  1190. 	print STDERR "$0: Your input file format is missing at least the field
    1191. 

  1191. \'$pattern\'. I can\'t parse it. Sorry. If you think that this field isn't
    1192. 

  1192. important to you, please report this error to <Calamaris-bug\@Cord.de>.
    1193. 

  1193. Thank You.\n\n";
    1194. 

  1194. 	exit(1);
    1195. 

  1195.       }
    1196. 

  1196.     }
    1197. 

  1197.     foreach $pattern (qw(%Req->vars.pauth-user% %Req->vars.actual-route%)) {
    1198. 

  1198.       unless ( grep /$pattern/, @fields ) {
    1199. 

  1199. 	if ( $pattern eq '%Req->vars.pauth-user%' ) {
    1200. 

  1200. 	  $tmpline2 .= '
    1201. 

  1201.   $log_ident = "-";';
    1202. 

  1202. 	} elsif ( $pattern eq '%Req->vars.actual-route%' ) {
    1203. 

  1203. 	  $tmpline2 .= '
    1204. 

  1204.     $log_hier = \'-/-\';
    1205. 

  1205.     $log_status = \'-/-\';';
    1206. 

  1206. 	}
    1207. 

  1207.       }
    1208. 

  1208.     }
    1209. 

  1209.     $loop .= $tmpline1 . '.?$#
    1210. 

  1210.     )
    1211. 

  1211.   {' . $tmpline2 . '
    1212. 

  1212.     $monthcount = -1;
    1213. 

  1213.     foreach $month (@months) {
    1214. 

  1214.       $monthcount++;
    1215. 

  1215.       last if ( $month eq $log_month );
    1216. 

  1216.     }
    1217. 

  1217.     $log_date = timegm(
    1218. 

  1218. 		       $log_sec, $log_min, $log_hour, $log_day, $monthcount,
    1219. 

  1219. 		       $log_year - 1900
    1220. 

  1220. 		       );
    1221. 

  1221.   } else {';
    1222. 

  1222.     while ( defined( $line = <> ) ) {
    1223. 

  1223.       last unless $line =~ /^\s*#/;
    1224. 

  1224.     }
    1225. 

  1225.   } else {
    1226. 

  1226.     print STDERR "$0: unknown value at -f -option: \"$opt_f\"\n\n$USAGE\n\n";
    1227. 

  1227.     exit 1;
    1228. 

  1228.   }
    1229. 

  1229.   $loop .= '
    1230. 

  1230.     chomp($line);';
    1231. 

  1231.   $loop .= '
    1232. 

  1232.     warn(\'invalid line: "\' . $line . "\"\n");' if $opt_v;
    1233. 

  1233.   $loop .= '
    1234. 

  1234.     $invalid++;
    1235. 

  1235.     next;
    1236. 

  1236.   }';
    1237. 

  1237.   $loop .= '
    1238. 

  1238.     if (($log_date < $interval_begin) or ($log_date > $interval_end)) {
    1239. 

  1239.       $skipped++;
    1240. 

  1240.       next;
    1241. 

  1241.     }
    1242. 

  1242.   ' if $opt_I;
    1243. 

  1243.   $loop .= '
    1244. 

  1244.   $log_reqtime = .1 if $log_reqtime == 0;
    1245. 

  1245.   ( $log_hitfail, $log_code ) = split \'/\', $log_status;
    1246. 

  1246.   $log_size = 0 if ( $log_size eq \'-\' );
    1247. 

  1247.   $log_url =~ s/\?.*$/?/;
    1248. 

  1248.   @url = split m#[/\\\]#o, $log_url;
    1249. 

  1249.   ( $urlprot, $urlhost, $urlext ) = (@url)[ 0, 2, $#url ];
    1250. 

  1250.   $urlext = \'.<none>\' if $#url <= 2;
    1251. 

  1251.   if ( $#url <= -1 ) {
    1252. 

  1252.     $urlext = \'.<error>\';
    1253. 

  1253.     $urlprot = $urlhost = \'<error>\';
    1254. 

  1254.   }
    1255. 

  1255.   $urlext = \'.<dynamic>\'
    1256. 

  1256.     if ( $urlext =~ m#[\?;&\$,!@=|%]#o or $log_method eq \'POST\' );
    1257. 

  1257.   unless ( defined $urlhost ) {
    1258. 

  1258.     $urlhost = $urlprot;';
    1259. 

  1259.   $loop .= '
    1260. 

  1260.     $log_content = '
    1261. 

  1261.     unless $opt_f eq 'squid-old'
    1262. 

  1262.       or $opt_f eq 'elff'
    1263. 

  1263.       or $opt_f eq 'nse';
    1264. 

  1264.   $loop .= '
    1265. 

  1265.     $urlprot = \'<secure>\';
    1266. 

  1266.     $urlext = \'.<secure>\';
    1267. 

  1267.   }
    1268. 

  1268.   $urlhost =~ s#^.*@##o;
    1269. 

  1269.   $urlhost =~ s#[:\?].*$##o;
    1270. 

  1270.   $urlhost =~ tr/A-Z/a-z/;
    1271. 

  1271.   @urlext = split \'\.\', $urlext;
    1272. 

  1272.   $urlext = (@urlext)[$#urlext];
    1273. 

  1273.   $urlext = \'<none>\' if $#urlext <= 0;';
    1274. 

  1274.   $loop .= '
    1275. 

  1275.   $urlext =~ tr/A-Z/a-z/;' if $opt_c;
    1276. 

  1276.   $loop .= '
    1277. 

  1277.   if ( $urlhost =~ m#^(([0-9][0-9]{0,2}\.){3})[0-9][0-9]{0,2}$#o ) {';
    1278. 

  1278.   $loop .= '
    1279. 

  1279.     $urlhost = $1 . \'*\';' unless $opt_N == -1;
    1280. 

  1280.   $loop .= '
    1281. 

  1281.     $urltld = \'<unresolved>\';
    1282. 

  1282.   } elsif ( $urlhost =~ m#^(.*\.([^\.]+\.)?)?([^\.]+\.([^\.]+))\.?$#o ) {
    1283. 

  1283.     @list = split \'\.\', $urlhost;
    1284. 

  1284.     $urltld = pop @list;';
    1285. 

  1285.   if ( $opt_N != -1 ) {
    1286. 

  1286.     $loop .= '
    1287. 

  1287.     $urlhost = $urltld;';
    1288. 

  1288.     for ( $i = $opt_N ; $i != 1 ; $i-- ) {
    1289. 

  1289.       $loop .= '
    1290. 

  1290.     $urlhost = pop (@list) . \'.\' . $urlhost if $#list >= 0;';
    1291. 

  1291.     }
    1292. 

  1292.     $loop .= '
    1293. 

  1293.     $urlhost = pop (@list) . \'.\' . $urlhost
    1294. 

  1294.       if ( $urltld =~
    1295. 

  1295. 	  m#^(a[rtu]|br|c[no]|hk|i[dlm]|jp|kr|l[by]|m[oxy]|nz|p[elnry]|sg|t[hrw]|u[aks]|ve|yu|za)$#o
    1296. 

  1296. 	  and $#list >= 0 );
    1297. 

  1297.     $urlhost = \'*.\' . $urlhost if $#list >= 0;
    1298. 

  1298.     $urltld = \'*.\' . $urltld;';
    1299. 

  1299.   }
    1300. 

  1300.   $loop .= '
    1301. 

  1301.   } elsif ( $urlhost =~ m#([!a-z0-9\.\-]|\.\.)#o ) {
    1302. 

  1302.     $urlhost = $urltld = $urlext = $urlprot = \'<error>\';
    1303. 

  1303.   } else {
    1304. 

  1304.     $urltld = $urlhost;
    1305. 

  1305.   }';
    1306. 

  1306.   if ($opt_n) {
    1307. 

  1307.     $loop .= '
    1308. 

  1308.   $requester = $log_requester;';
    1309. 

  1309.   } else {
    1310. 

  1310.     $loop .= '
    1311. 

  1311.   $requester = getfqdn($log_requester);';
    1312. 

  1312.   }
    1313. 

  1313.   $loop .= '
    1314. 

  1314.   $requester = $log_ident . \'@\' . $requester if $log_ident ne \'-\';'
    1315. 

  1315.     if $opt_u;
    1316. 

  1316.   $loop .= '
    1317. 

  1317.   ( $log_hier_method, $log_hier_host ) = ( split \'/\', $log_hier )[ 0, 1 ];';
    1318. 

  1318.   $loop .= '
    1319. 

  1319.   $log_content = \'<unknown>\' if $log_content eq \'-\';
    1320. 

  1320.   $log_content =~ tr/A-Z/a-z/;
    1321. 

  1321.   $log_content = '
    1322. 

  1322.     unless $opt_f eq 'squid-old'
    1323. 

  1323.     or $opt_f eq 'elff'
    1324. 

  1324.     or $opt_f eq 'nse';
    1325. 

  1325.   $loop .= '
    1326. 

  1326.   $urlhost = $urltld = $urlext = $urlprot = \'<error>\'
    1327. 

  1327.     if ( $log_code =~ m#^[45]#o );';
    1328. 

  1328.   $loop .= "
    1329. 

  1329.   print STDERR '#' if (0 == (\$counter % $opt_b));" if $opt_b;
    1330. 

  1330.   $loop .= '
    1331. 

  1331.   $counter++;
    1332. 

  1332.   $size += $log_size;
    1333. 

  1333.   $time += $log_reqtime;
    1334. 

  1334.   $method{$log_method} = $method_size{$log_method} =
    1335. 

  1335.     $method_time{$log_method} = 0
    1336. 

  1336.     unless defined $method{$log_method};
    1337. 

  1337.   $method{$log_method}++;
    1338. 

  1338.   $method_size{$log_method} += $log_size;
    1339. 

  1339.   $method_time{$log_method} += $log_reqtime;
    1340. 

  1340.   $time_begin = $log_date if $log_date < $time_begin;
    1341. 

  1341.   $time_end = $log_date if $log_date > $time_end;';
    1342. 

  1342.   if ( defined $opt_p ) {
    1343. 

  1343.     $loop .= '
    1344. 

  1344.   if ( defined(@peak_all) ) {
    1345. 

  1345.     if ( $log_date < $peak_all[$#peak_all] ) {
    1346. 

  1346.       $peak_warn =
    1347. 

  1347. 	\'Peak values are most likely wrong due to unsorted input!\';
    1348. 

  1348.       undef(@peak_all);
    1349. 

  1349.       undef(@peak_udp);
    1350. 

  1350.       undef(@peak_tcp);
    1351. 

  1351.       $peak_all_min_pointer = $peak_all_sec_pointer = $peak_tcp_min_pointer =
    1352. 

  1352. 	$peak_tcp_sec_pointer = $peak_udp_min_pointer =
    1353. 

  1353. 	$peak_udp_sec_pointer = 0;
    1354. 

  1354.       chomp($line);
    1355. 

  1355.       warn( \'unsorted input: "\' . $line . "\"\n" ) if $opt_v;
    1356. 

  1356.     }
    1357. 

  1357.   }';
    1358. 

  1358.     if ( $opt_p eq 'old' ) {
    1359. 

  1359.       $loop .= '
    1360. 

  1360.   $peak_all_sec_pointer++;
    1361. 

  1361.   $peak_all_min_pointer++;
    1362. 

  1362.   unshift ( @peak_all, $log_date );
    1363. 

  1363.   $peak_all_sec_pointer--
    1364. 

  1364.     while $peak_all[ $peak_all_sec_pointer - 1 ] < ( $log_date - 1 );
    1365. 

  1365.   $peak_all_min_pointer--
    1366. 

  1366.     while $peak_all[ $peak_all_min_pointer - 1 ] < ( $log_date - 60 );
    1367. 

  1367.   pop (@peak_all) while $peak_all[$#peak_all] < ( $log_date - 3600 );
    1368. 

  1368.   if ( $peak_all_hour < @peak_all ) {
    1369. 

  1369.     $peak_all_hour = @peak_all;
    1370. 

  1370.     $peak_all_hour_time = $log_date - 3600;
    1371. 

  1371.   }
    1372. 

  1372.   if ( $peak_all_min < $peak_all_min_pointer ) {
    1373. 

  1373.     $peak_all_min = $peak_all_min_pointer;
    1374. 

  1374.     $peak_all_min_time = $log_date - 60;
    1375. 

  1375.   }
    1376. 

  1376.   if ( $peak_all_sec < $peak_all_sec_pointer ) {
    1377. 

  1377.     $peak_all_sec = $peak_all_sec_pointer;
    1378. 

  1378.     $peak_all_sec_time = $log_date - 1;
    1379. 

  1379.   }';
    1380. 

  1380.     } elsif ( $opt_p eq 'new' ) {
    1381. 

  1381.       $loop .= '
    1382. 

  1382.   $date_hour = int( ( $log_date - ( $log_reqtime / 1000 ) ) / 3600 ) * 3600;
    1383. 

  1383.   foreach $i ( ( $date_hour / 3600 ) .. int( $log_date / 3600 ) ) {
    1384. 

  1384.     $peak_all_hour{ $i * 3600 } = $peak_all_hour_size{ $i * 3600 } = 0
    1385. 

  1385.       unless defined $peak_all_hour{ $i * 3600 };
    1386. 

  1386.     $peak_all_hour{ $i * 3600 }++;
    1387. 

  1387.     $peak_all_hour_size{ $i * 3600 } +=
    1388. 

  1388.       $log_size / int( $log_reqtime / 3600000 + 1 );
    1389. 

  1389.   }
    1390. 

  1390.   $peak_all_sec_pointer++;
    1391. 

  1391.   unshift ( @peak_all, $log_date );
    1392. 

  1392.   $peak_all_sec_pointer--
    1393. 

  1393.     while $peak_all[ $peak_all_sec_pointer - 1 ] < ( $log_date - 1 );
    1394. 

  1394.   pop (@peak_all) while $peak_all[$#peak_all] < ( $log_date - 60 );
    1395. 

  1395.   if ( $peak_all_min < @peak_all ) {
    1396. 

  1396.     $peak_all_min = @peak_all;
    1397. 

  1397.     $peak_all_min_time = $log_date - 60;
    1398. 

  1398.   }
    1399. 

  1399.   if ( $peak_all_sec < $peak_all_sec_pointer ) {
    1400. 

  1400.     $peak_all_sec = $peak_all_sec_pointer;
    1401. 

  1401.     $peak_all_sec_time = $log_date - 1;
    1402. 

  1402.   }';
    1403. 

  1403.     } else {
    1404. 

  1404.       print STDERR
    1405. 

  1405. 	"$0: unknown value at -p -option: \"$opt_p\"\n\n$USAGE\n\n";
    1406. 

  1406.       exit 1;
    1407. 

  1407.     }
    1408. 

  1408.   }
    1409. 

  1409.   $loop .= '
    1410. 

  1410.   if ( ( $log_method =~ m#^ICP_#o ) or ( $log_status =~ m#^ICP#o ) ) {
    1411. 

  1411.     $udp++;
    1412. 

  1412.     $udp_size += $log_size;
    1413. 

  1413.     $udp_time += $log_reqtime;';
    1414. 

  1414.   $loop .= '
    1415. 

  1415.     $udp_requester{$requester} = $udp_requester_size{$requester} =
    1416. 

  1416.       $udp_requester_time{$requester} = $udp_hit_requester{$requester} =
    1417. 

  1417.       $udp_hit_requester_size{$requester} = 0
    1418. 

  1418.       unless defined $udp_requester{$requester};
    1419. 

  1419.     $udp_requester{$requester}++;
    1420. 

  1420.     $udp_requester_size{$requester} += $log_size;
    1421. 

  1421.     $udp_requester_time{$requester} += $log_reqtime;' if ($opt_r);
    1422. 

  1422.   $loop .= '
    1423. 

  1423.     $udp_requester_urlhost{$requester}{$urlhost} =
    1424. 

  1424.       $udp_requester_urlhost_size{$requester}{$urlhost} =
    1425. 

  1425.       $udp_requester_urlhost_time{$requester}{$urlhost} =
    1426. 

  1426.       $udp_hit_requester_urlhost{$requester}{$urlhost} =
    1427. 

  1427.       $udp_hit_requester_urlhost_size{$requester}{$urlhost} = 0
    1428. 

  1428.       unless defined $udp_requester_urlhost{$requester}{$urlhost};
    1429. 

  1429.     $udp_requester_urlhost{$requester}{$urlhost}++;
    1430. 

  1430.     $udp_requester_urlhost_size{$requester}{$urlhost} += $log_size;
    1431. 

  1431.     $udp_requester_urlhost_time{$requester}{$urlhost} += $log_reqtime;'
    1432. 

  1432.     if ($opt_R);
    1433. 

  1433.   if ( not defined $opt_p ) {
    1434. 

  1434.   } elsif ( $opt_p eq 'old' ) {
    1435. 

  1435.     $loop .= '
    1436. 

  1436.     $peak_udp_sec_pointer++;
    1437. 

  1437.     $peak_udp_min_pointer++;
    1438. 

  1438.     unshift ( @peak_udp, $log_date );
    1439. 

  1439.     $peak_udp_sec_pointer--
    1440. 

  1440.       while $peak_udp[ $peak_udp_sec_pointer - 1 ] < ( $log_date - 1 );
    1441. 

  1441.     $peak_udp_min_pointer--
    1442. 

  1442.       while $peak_udp[ $peak_udp_min_pointer - 1 ] < ( $log_date - 60 );
    1443. 

  1443.     pop @peak_udp while $peak_udp[$#peak_udp] < ( $log_date - 3600 );
    1444. 

  1444.     if ( $peak_udp_hour < @peak_udp ) {
    1445. 

  1445.       $p…
    1446.