package SquidAnalyzer; #------------------------------------------------------------------------------ # Project : Squid Log Analyzer # Name : SquidAnalyzer.pm # Language : Perl 5 # OS : All # Copyright: Copyright (c) 2001-2014 Gilles Darold - All rights reserved. # Licence : This program is free software; you can redistribute it # and/or modify it under the same terms as Perl itself. # Author : Gilles Darold, gilles _AT_ darold _DOT_ net # Function : Main perl module for Squid Log Analyzer # Usage : See documentation. #------------------------------------------------------------------------------ use strict; # make things properly BEGIN { use Exporter(); use vars qw($VERSION $COPYRIGHT $AUTHOR @ISA @EXPORT $ZCAT_PROG $BZCAT_PROG $RM_PROG); use POSIX qw/ strftime /; use IO::File; use Socket; use Time::HiRes qw/ualarm/; use Time::Local 'timelocal_nocheck'; # Set all internal variable $VERSION = '5.4'; $COPYRIGHT = 'Copyright (c) 2001-2014 Gilles Darold - All rights reserved.'; $AUTHOR = "Gilles Darold - gilles _AT_ darold _DOT_ net"; @ISA = qw(Exporter); @EXPORT = qw//; $| = 1; } $ZCAT_PROG = "/bin/zcat"; $BZCAT_PROG = "/bin/bzcat"; $RM_PROG = "/bin/rm"; # DNS Cache my %CACHE = (); # Color used to draw grpahs my @GRAPH_COLORS = ('#6e9dc9', '#f4ab3a', '#ac7fa8', '#8dbd0f'); # Default translation srings my %Translate = ( 'CharSet' => 'utf-8', '01' => 'Jan', '02' => 'Feb', '03' => 'Mar', '04' => 'Apr', '05' => 'May', '06' => 'Jun', '07' => 'Jul', '08' => 'Aug', '09' => 'Sep', '10' => 'Oct', '11' => 'Nov', '12' => 'Dec', 'KB' => 'Kilo bytes', 'MB' => 'Mega bytes', 'GB' => 'Giga bytes', 'Bytes' => 'Bytes', 'Total' => 'Total', 'Years' => 'Years', 'Users' => 'Users', 'Sites' => 'Sites', 'Cost' => 'Cost', 'Requests' => 'Requests', 'Megabytes' => 'Mega bytes', 'Months' => 'Months', 'Days' => 'Days', 'Hit' => 'Hit', 'Miss' => 'Miss', 'Denied' => 'Denied', 'Domains' => 'Domains', 'Requests_graph' => 'Requests', 'Megabytes_graph' => 'Mega bytes', 'Months_graph' => 'Months', 'Days_graph' => 'Days', 'Hit_graph' => 'Hit', 'Miss_graph' => 'Miss', 'Denied_graph' => 'Denied', 'Total_graph' => 'Total', 'Domains_graph' => 'Domains', 'Users_help' => 'Total number of different users for this period', 'Sites_help' => 'Total number of different visited sites for this period', 'Domains_help' => 'Total number of different second level visited domain for this period', 'Hit_help' => 'Objects found in cache', 'Miss_help' => 'Objects not found in cache', 'Denied_help' => 'Objects with denied access', 'Cost_help' => '1 Mega byte =', 'Generation' => 'Report generated on', 'Main_cache_title' => 'Cache Statistics', 'Cache_title' => 'Cache Statistics on', 'Stat_label' => 'Stat', 'Mime_link' => 'Mime Types', 'Network_link' => 'Networks', 'User_link' => 'Users', 'Top_url_link' => 'Top Urls', 'Top_domain_link' => 'Top Domains', 'Back_link' => 'Back', 'Graph_cache_hit_title' => '%s Requests statistics on', 'Graph_cache_byte_title' => '%s Mega Bytes statistics on', 'Hourly' => 'Hourly', 'Hours' => 'Hours', 'Daily' => 'Daily', 'Days' => 'Days', 'Monthly' => 'Monthly', 'Months' => 'Months', 'Mime_title' => 'Mime Type Statistics on', 'Mime_number' => 'Number of mime type', 'Network_title' => 'Network Statistics on', 'Network_number' => 'Number of network', 'Duration' => 'Duration', 'Time' => 'Time', 'Largest' => 'Largest', 'Url' => 'Url', 'User_title' => 'User Statistics on', 'User_number' => 'Number of user', 'Url_Hits_title' => 'Top %d Url hits on', 'Url_Bytes_title' => 'Top %d Url bytes on', 'Url_Duration_title' => 'Top %d Url duration on', 'Url_number' => 'Number of Url', 'Domain_Hits_title' => 'Top %d Domain hits on', 'Domain_Bytes_title' => 'Top %d Domain bytes on', 'Domain_Duration_title' => 'Top %d Domain duration on', 'Domain_number' => 'Number of domain', 'Domain_graph_hits_title' => 'Domain Hits Statistics on', 'Domain_graph_bytes_title' => 'Domain Bytes Statistiques on', 'Second_domain_graph_hits_title' => 'Second level Hits Statistics on', 'Second_domain_graph_bytes_title' => 'Second level Bytes Statistiques on', 'First_visit' => 'First visit', 'Last_visit' => 'Last visit', 'Globals_Statistics' => 'Globals Statistics', 'Legend' => 'Legend', 'File_Generated' => 'File generated by', 'Up_link' => 'Up', 'Click_year_stat' => 'Click on year\'s statistics link for details', 'Mime_graph_hits_title' => 'Mime Type Hits Statistics on', 'Mime_graph_bytes_title' => 'Mime Type Bytes Statistiques on', 'User' => 'User', 'Count' => 'Count', 'WeekDay' => 'Su Mo Tu We Th Fr Sa', 'Week' => 'Week', ); my @TLD1 = ( '\.com\.ac','\.net\.ac','\.gov\.ac','\.org\.ac','\.mil\.ac','\.co\.ae', '\.net\.ae','\.gov\.ae','\.ac\.ae','\.sch\.ae','\.org\.ae','\.mil\.ae','\.pro\.ae', '\.name\.ae','\.com\.af','\.edu\.af','\.gov\.af','\.net\.af','\.org\.af','\.com\.al', '\.edu\.al','\.gov\.al','\.mil\.al','\.net\.al','\.org\.al','\.ed\.ao','\.gv\.ao', '\.og\.ao','\.co\.ao','\.pb\.ao','\.it\.ao','\.com\.ar','\.edu\.ar','\.gob\.ar', '\.gov\.ar','\.gov\.ar','\.int\.ar','\.mil\.ar','\.net\.ar','\.org\.ar','\.tur\.ar', '\.gv\.at','\.ac\.at','\.co\.at','\.or\.at','\.com\.au','\.net\.au','\.org\.au', '\.edu\.au','\.gov\.au','\.csiro\.au','\.asn\.au','\.id\.au','\.org\.ba','\.net\.ba', '\.edu\.ba','\.gov\.ba','\.mil\.ba','\.unsa\.ba','\.untz\.ba','\.unmo\.ba','\.unbi\.ba', '\.unze\.ba','\.co\.ba','\.com\.ba','\.rs\.ba','\.co\.bb','\.com\.bb','\.net\.bb', '\.org\.bb','\.gov\.bb','\.edu\.bb','\.info\.bb','\.store\.bb','\.tv\.bb','\.biz\.bb', '\.com\.bh','\.info\.bh','\.cc\.bh','\.edu\.bh','\.biz\.bh','\.net\.bh','\.org\.bh', '\.gov\.bh','\.com\.bn','\.edu\.bn','\.gov\.bn','\.net\.bn','\.org\.bn','\.com\.bo', '\.net\.bo','\.org\.bo','\.tv\.bo','\.mil\.bo','\.int\.bo','\.gob\.bo','\.gov\.bo', '\.edu\.bo','\.adm\.br','\.adv\.br','\.agr\.br','\.am\.br','\.arq\.br','\.art\.br', '\.ato\.br','\.b\.br','\.bio\.br','\.blog\.br','\.bmd\.br','\.cim\.br','\.cng\.br', '\.cnt\.br','\.com\.br','\.coop\.br','\.ecn\.br','\.edu\.br','\.eng\.br','\.esp\.br', '\.etc\.br','\.eti\.br','\.far\.br','\.flog\.br','\.fm\.br','\.fnd\.br','\.fot\.br', '\.fst\.br','\.g12\.br','\.ggf\.br','\.gov\.br','\.imb\.br','\.ind\.br','\.inf\.br', '\.jor\.br','\.jus\.br','\.lel\.br','\.mat\.br','\.med\.br','\.mil\.br','\.mus\.br', '\.net\.br','\.nom\.br','\.not\.br','\.ntr\.br','\.odo\.br','\.org\.br','\.ppg\.br', '\.pro\.br','\.psc\.br','\.psi\.br','\.qsl\.br','\.rec\.br','\.slg\.br','\.srv\.br', '\.tmp\.br','\.trd\.br','\.tur\.br','\.tv\.br','\.vet\.br','\.vlog\.br','\.wiki\.br', '\.zlg\.br','\.com\.bs','\.net\.bs','\.org\.bs','\.edu\.bs','\.gov\.bs','com\.bz', 'edu\.bz','gov\.bz','net\.bz','org\.bz','\.ab\.ca','\.bc\.ca','\.mb\.ca','\.nb\.ca', '\.nf\.ca','\.nl\.ca','\.ns\.ca','\.nt\.ca','\.nu\.ca','\.on\.ca','\.pe\.ca','\.qc\.ca', '\.sk\.ca','\.yk\.ca','\.co\.ck','\.org\.ck','\.edu\.ck','\.gov\.ck','\.net\.ck', '\.gen\.ck','\.biz\.ck','\.info\.ck','\.ac\.cn','\.com\.cn','\.edu\.cn','\.gov\.cn', '\.mil\.cn','\.net\.cn','\.org\.cn','\.ah\.cn','\.bj\.cn','\.cq\.cn','\.fj\.cn','\.gd\.cn', '\.gs\.cn','\.gz\.cn','\.gx\.cn','\.ha\.cn','\.hb\.cn','\.he\.cn','\.hi\.cn','\.hl\.cn', '\.hn\.cn','\.jl\.cn','\.js\.cn','\.jx\.cn','\.ln\.cn','\.nm\.cn','\.nx\.cn','\.qh\.cn', '\.sc\.cn','\.sd\.cn','\.sh\.cn','\.sn\.cn','\.sx\.cn','\.tj\.cn','\.tw\.cn','\.xj\.cn', '\.xz\.cn','\.yn\.cn','\.zj\.cn','\.com\.co','\.org\.co','\.edu\.co','\.gov\.co', '\.net\.co','\.mil\.co','\.nom\.co','\.ac\.cr','\.co\.cr','\.ed\.cr','\.fi\.cr','\.go\.cr', '\.com\.cu','\.edu\.cu','\.gov\.cu','\.net\.cu','\.org\.cu', '\.or\.cr','\.sa\.cr','\.cr','\.ac\.cy','\.net\.cy','\.gov\.cy','\.org\.cy', '\.pro\.cy','\.name\.cy','\.ekloges\.cy','\.tm\.cy','\.ltd\.cy','\.biz\.cy','\.press\.cy', '\.parliament\.cy','\.com\.cy','\.edu\.do','\.gob\.do','\.gov\.do','\.com\.do','\.sld\.do', '\.org\.do','\.net\.do','\.web\.do','\.mil\.do','\.art\.do','\.com\.dz','\.org\.dz', '\.net\.dz','\.gov\.dz','\.edu\.dz','\.asso\.dz','\.pol\.dz','\.art\.dz','\.com\.ec', '\.info\.ec','\.net\.ec','\.fin\.ec','\.med\.ec','\.pro\.ec','\.org\.ec','\.edu\.ec', '\.gov\.ec','\.mil\.ec','\.com\.eg','\.edu\.eg','\.eun\.eg','\.gov\.eg','\.mil\.eg', '\.name\.eg','\.net\.eg','\.org\.eg','\.sci\.eg','\.com\.er','\.edu\.er','\.gov\.er', '\.mil\.er','\.net\.er','\.org\.er','\.ind\.er','\.rochest\.er','\.w\.er','\.com\.es', '\.nom\.es','\.org\.es','\.gob\.es','\.edu\.es','\.com\.et','\.gov\.et','\.org\.et', '\.edu\.et','\.net\.et','\.biz\.et','\.name\.et','\.info\.et','\.ac\.fj','\.biz\.fj', '\.com\.fj','\.info\.fj','\.mil\.fj','\.name\.fj','\.net\.fj','\.org\.fj','\.pro\.fj', '\.co\.fk','\.org\.fk','\.gov\.fk','\.ac\.fk','\.nom\.fk','\.net\.fk','\.fr','\.tm\.fr', '\.asso\.fr','\.nom\.fr','\.prd\.fr','\.presse\.fr','\.com\.fr','\.gouv\.fr','\.co\.gg', '\.net\.gg','\.org\.gg','\.com\.gh','\.edu\.gh','\.gov\.gh','\.org\.gh','\.mil\.gh', '\.com\.gn','\.ac\.gn','\.gov\.gn','\.org\.gn','\.net\.gn','\.com\.gr','\.edu\.gr','\.net\.gr', '\.org\.gr','\.gov\.gr','\.mil\.gr','\.com\.gt','\.edu\.gt','\.net\.gt','\.gob\.gt', '\.org\.gt','\.mil\.gt','\.ind\.gt','\.com\.gu','\.net\.gu','\.gov\.gu','\.org\.gu','\.edu\.gu', '\.com\.hk','\.edu\.hk','\.gov\.hk','\.idv\.hk','\.net\.hk','\.org\.hk','\.ac\.id','\.co\.id', '\.net\.id','\.or\.id','\.web\.id','\.sch\.id','\.mil\.id','\.go\.id','\.war\.net\.id','\.ac\.il', '\.co\.il','\.org\.il','\.net\.il','\.k12\.il','\.gov\.il','\.muni\.il','\.idf\.il','\.in', '\.co\.in','\.firm\.in','\.net\.in','\.org\.in','\.gen\.in','\.ind\.in','\.ac\.in','\.edu\.in', '\.res\.in','\.ernet\.in','\.gov\.in','\.mil\.in','\.nic\.in','\.nic\.in','\.iq','\.gov\.iq', '\.edu\.iq','\.com\.iq','\.mil\.iq','\.org\.iq','\.net\.iq','\.ir','\.ac\.ir','\.co\.ir', '\.gov\.ir','\.id\.ir','\.net\.ir','\.org\.ir','\.sch\.ir','\.dnssec\.ir','\.gov\.it', '\.edu\.it','\.co\.je','\.net\.je','\.org\.je','\.com\.jo','\.net\.jo','\.gov\.jo','\.edu\.jo', '\.org\.jo','\.mil\.jo','\.name\.jo','\.sch\.jo','\.ac\.jp','\.ad\.jp','\.co\.jp','\.ed\.jp', '\.go\.jp','\.gr\.jp','\.lg\.jp','\.ne\.jp','\.or\.jp','\.co\.ke','\.or\.ke','\.ne\.ke','\.go\.ke', '\.ac\.ke','\.sc\.ke','\.me\.ke','\.mobi\.ke','\.info\.ke','\.per\.kh','\.com\.kh','\.edu\.kh', '\.gov\.kh','\.mil\.kh','\.net\.kh','\.org\.kh','\.com\.ki','\.biz\.ki','\.de\.ki','\.net\.ki', '\.info\.ki','\.org\.ki','\.gov\.ki','\.edu\.ki','\.mob\.ki','\.tel\.ki','\.km','\.com\.km', '\.coop\.km','\.asso\.km','\.nom\.km','\.presse\.km','\.tm\.km','\.medecin\.km','\.notaires\.km', '\.pharmaciens\.km','\.veterinaire\.km','\.edu\.km','\.gouv\.km','\.mil\.km','\.net\.kn', '\.org\.kn','\.edu\.kn','\.gov\.kn','\.kr','\.co\.kr','\.ne\.kr','\.or\.kr','\.re\.kr','\.pe\.kr', '\.go\.kr','\.mil\.kr','\.ac\.kr','\.hs\.kr','\.ms\.kr','\.es\.kr','\.sc\.kr','\.kg\.kr', '\.seoul\.kr','\.busan\.kr','\.daegu\.kr','\.incheon\.kr','\.gwangju\.kr','\.daejeon\.kr', '\.ulsan\.kr','\.gyeonggi\.kr','\.gangwon\.kr','\.chungbuk\.kr','\.chungnam\.kr','\.jeonbuk\.kr', '\.jeonnam\.kr','\.gyeongbuk\.kr','\.gyeongnam\.kr','\.jeju\.kr','\.edu\.kw','\.com\.kw', '\.net\.kw','\.org\.kw','\.gov\.kw','\.com\.ky','\.org\.ky','\.net\.ky','\.edu\.ky','\.gov\.ky', '\.com\.kz','\.edu\.kz','\.gov\.kz','\.mil\.kz','\.net\.kz','\.org\.kz','\.com\.lb','\.edu\.lb', '\.gov\.lb','\.net\.lb','\.org\.lb','\.gov\.lk','\.sch\.lk','\.net\.lk','\.int\.lk','\.com\.lk', '\.org\.lk','\.edu\.lk','\.ngo\.lk','\.soc\.lk','\.web\.lk','\.ltd\.lk','\.assn\.lk','\.grp\.lk', '\.hotel\.lk','\.com\.lr','\.edu\.lr','\.gov\.lr','\.org\.lr','\.net\.lr','\.com\.lv','\.edu\.lv', '\.gov\.lv','\.org\.lv','\.mil\.lv','\.id\.lv','\.net\.lv','\.asn\.lv','\.conf\.lv','\.com\.ly', '\.net\.ly','\.gov\.ly','\.plc\.ly','\.edu\.ly','\.sch\.ly','\.med\.ly','\.org\.ly','\.id\.ly', '\.ma','\.net\.ma','\.ac\.ma','\.org\.ma','\.gov\.ma','\.press\.ma','\.co\.ma','\.tm\.mc', '\.asso\.mc','\.co\.me','\.net\.me','\.org\.me','\.edu\.me','\.ac\.me','\.gov\.me','\.its\.me', '\.priv\.me','\.org\.mg','\.nom\.mg','\.gov\.mg','\.prd\.mg','\.tm\.mg','\.edu\.mg','\.mil\.mg', '\.com\.mg','\.com\.mk','\.org\.mk','\.net\.mk','\.edu\.mk','\.gov\.mk','\.inf\.mk','\.name\.mk', '\.pro\.mk','\.com\.ml','\.net\.ml','\.org\.ml','\.edu\.ml','\.gov\.ml','\.presse\.ml','\.gov\.mn', '\.edu\.mn','\.org\.mn','\.com\.mo','\.edu\.mo','\.gov\.mo','\.net\.mo','\.org\.mo','\.com\.mt', '\.org\.mt','\.net\.mt','\.edu\.mt','\.gov\.mt','\.aero\.mv','\.biz\.mv','\.com\.mv','\.coop\.mv', '\.edu\.mv','\.gov\.mv','\.info\.mv','\.int\.mv','\.mil\.mv','\.museum\.mv','\.name\.mv','\.net\.mv', '\.org\.mv','\.pro\.mv','\.ac\.mw','\.co\.mw','\.com\.mw','\.coop\.mw','\.edu\.mw','\.gov\.mw', '\.int\.mw','\.museum\.mw','\.net\.mw','\.org\.mw','\.com\.mx','\.net\.mx','\.org\.mx','\.edu\.mx', '\.gob\.mx','\.com\.my','\.net\.my','\.org\.my','\.gov\.my','\.edu\.my','\.sch\.my','\.mil\.my', '\.name\.my','\.com\.nf','\.net\.nf','\.arts\.nf','\.store\.nf','\.web\.nf','\.firm\.nf', '\.info\.nf','\.other\.nf','\.per\.nf','\.rec\.nf','\.com\.ng','\.org\.ng','\.gov\.ng','\.edu\.ng', '\.net\.ng','\.sch\.ng','\.name\.ng','\.mobi\.ng','\.biz\.ng','\.mil\.ng','\.gob\.ni','\.co\.ni', '\.com\.ni','\.ac\.ni','\.edu\.ni','\.org\.ni','\.nom\.ni','\.net\.ni','\.mil\.ni','\.com\.np', '\.edu\.np','\.gov\.np','\.org\.np','\.mil\.np','\.net\.np','\.edu\.nr','\.gov\.nr','\.biz\.nr', '\.info\.nr','\.net\.nr','\.org\.nr','\.com\.nr','\.com\.om','\.co\.om','\.edu\.om','\.ac\.om', '\.sch\.om','\.gov\.om','\.net\.om','\.org\.om','\.mil\.om','\.museum\.om','\.biz\.om','\.pro\.om', '\.med\.om','\.edu\.pe','\.gob\.pe','\.nom\.pe','\.mil\.pe','\.sld\.pe','\.org\.pe','\.com\.pe', '\.net\.pe','\.com\.ph','\.net\.ph','\.org\.ph','\.mil\.ph','\.ngo\.ph','\.i\.ph','\.gov\.ph', '\.edu\.ph','\.com\.pk','\.net\.pk','\.edu\.pk','\.org\.pk','\.fam\.pk','\.biz\.pk','\.web\.pk', '\.gov\.pk','\.gob\.pk','\.gok\.pk','\.gon\.pk','\.gop\.pk','\.gos\.pk','\.pwr\.pl','\.com\.pl', '\.biz\.pl','\.net\.pl','\.art\.pl','\.edu\.pl','\.org\.pl','\.ngo\.pl','\.gov\.pl','\.info\.pl', '\.mil\.pl','\.waw\.pl','\.warszawa\.pl','\.wroc\.pl','\.wroclaw\.pl','\.krakow\.pl','\.katowice\.pl', '\.poznan\.pl','\.lodz\.pl','\.gda\.pl','\.gdansk\.pl','\.slupsk\.pl','\.radom\.pl','\.szczecin\.pl', '\.lublin\.pl','\.bialystok\.pl','\.olsztyn\.pl','\.torun\.pl','\.gorzow\.pl','\.zgora\.pl', '\.biz\.pr','\.com\.pr','\.edu\.pr','\.gov\.pr','\.info\.pr','\.isla\.pr','\.name\.pr','\.net\.pr', '\.org\.pr','\.pro\.pr','\.est\.pr','\.prof\.pr','\.ac\.pr','\.com\.ps','\.net\.ps','\.org\.ps', '\.edu\.ps','\.gov\.ps','\.plo\.ps','\.sec\.ps','\.co\.pw','\.ne\.pw','\.or\.pw','\.ed\.pw','\.go\.pw', '\.belau\.pw','\.arts\.ro','\.com\.ro','\.firm\.ro','\.info\.ro','\.nom\.ro','\.nt\.ro','\.org\.ro', '\.rec\.ro','\.store\.ro','\.tm\.ro','\.www\.ro','\.co\.rs','\.org\.rs','\.edu\.rs','\.ac\.rs', '\.gov\.rs','\.in\.rs','\.com\.sb','\.net\.sb','\.edu\.sb','\.org\.sb','\.gov\.sb','\.com\.sc', '\.net\.sc','\.edu\.sc','\.gov\.sc','\.org\.sc','\.co\.sh','\.com\.sh','\.org\.sh','\.gov\.sh', '\.edu\.sh','\.net\.sh','\.nom\.sh','\.com\.sl','\.net\.sl','\.org\.sl','\.edu\.sl','\.gov\.sl', '\.gov\.st','\.saotome\.st','\.principe\.st','\.consulado\.st','\.embaixada\.st','\.org\.st', '\.edu\.st','\.net\.st','\.com\.st','\.store\.st','\.mil\.st','\.co\.st','\.edu\.sv','\.gob\.sv', '\.com\.sv','\.org\.sv','\.red\.sv','\.co\.sz','\.ac\.sz','\.org\.sz','\.com\.tr','\.gen\.tr', '\.org\.tr','\.biz\.tr','\.info\.tr','\.av\.tr','\.dr\.tr','\.pol\.tr','\.bel\.tr','\.tsk\.tr', '\.bbs\.tr','\.k12\.tr','\.edu\.tr','\.name\.tr','\.net\.tr','\.gov\.tr','\.web\.tr','\.tel\.tr', '\.tv\.tr','\.co\.tt','\.com\.tt','\.org\.tt','\.net\.tt','\.biz\.tt','\.info\.tt','\.pro\.tt', '\.int\.tt','\.coop\.tt','\.jobs\.tt','\.mobi\.tt','\.travel\.tt','\.museum\.tt','\.aero\.tt', '\.cat\.tt','\.tel\.tt','\.name\.tt','\.mil\.tt','\.edu\.tt','\.gov\.tt','\.edu\.tw','\.gov\.tw', '\.mil\.tw','\.com\.tw','\.net\.tw','\.org\.tw','\.idv\.tw','\.game\.tw','\.ebiz\.tw','\.club\.tw', '\.com\.mu','\.gov\.mu','\.net\.mu','\.org\.mu','\.ac\.mu','\.co\.mu','\.or\.mu','\.ac\.mz', '\.co\.mz','\.edu\.mz','\.org\.mz','\.gov\.mz','\.com\.na','\.co\.na','\.ac\.nz','\.co\.nz', '\.cri\.nz','\.geek\.nz','\.gen\.nz','\.govt\.nz','\.health\.nz','\.iwi\.nz','\.maori\.nz', '\.mil\.nz','\.net\.nz','\.org\.nz','\.parliament\.nz','\.school\.nz','\.abo\.pa','\.ac\.pa', '\.com\.pa','\.edu\.pa','\.gob\.pa','\.ing\.pa','\.med\.pa','\.net\.pa','\.nom\.pa','\.org\.pa', '\.sld\.pa','\.com\.pt','\.edu\.pt','\.gov\.pt','\.int\.pt','\.net\.pt','\.nome\.pt','\.org\.pt', '\.publ\.pt','\.com\.py','\.edu\.py','\.gov\.py','\.mil\.py','\.net\.py','\.org\.py','\.com\.qa', '\.edu\.qa','\.gov\.qa','\.mil\.qa','\.net\.qa','\.org\.qa','\.asso\.re','\.com\.re','\.nom\.re', '\.ac\.ru','\.adygeya\.ru','\.altai\.ru','\.amur\.ru','\.arkhangelsk\.ru','\.astrakhan\.ru', '\.bashkiria\.ru','\.belgorod\.ru','\.bir\.ru','\.bryansk\.ru','\.buryatia\.ru','\.cbg\.ru', '\.chel\.ru','\.chelyabinsk\.ru','\.chita\.ru','\.chita\.ru','\.chukotka\.ru','\.chuvashia\.ru', '\.com\.ru','\.dagestan\.ru','\.e-burg\.ru','\.edu\.ru','\.gov\.ru','\.grozny\.ru','\.int\.ru', '\.irkutsk\.ru','\.ivanovo\.ru','\.izhevsk\.ru','\.jar\.ru','\.joshkar-ola\.ru','\.kalmykia\.ru', '\.kaluga\.ru','\.kamchatka\.ru','\.karelia\.ru','\.kazan\.ru','\.kchr\.ru','\.kemerovo\.ru', '\.khabarovsk\.ru','\.khakassia\.ru','\.khv\.ru','\.kirov\.ru','\.koenig\.ru','\.komi\.ru', '\.kostroma\.ru','\.kranoyarsk\.ru','\.kuban\.ru','\.kurgan\.ru','\.kursk\.ru','\.lipetsk\.ru', '\.magadan\.ru','\.mari\.ru','\.mari-el\.ru','\.marine\.ru','\.mil\.ru','\.mordovia\.ru', '\.mosreg\.ru','\.msk\.ru','\.murmansk\.ru','\.nalchik\.ru','\.net\.ru','\.nnov\.ru','\.nov\.ru', '\.novosibirsk\.ru','\.nsk\.ru','\.omsk\.ru','\.orenburg\.ru','\.org\.ru','\.oryol\.ru','\.penza\.ru', '\.perm\.ru','\.pp\.ru','\.pskov\.ru','\.ptz\.ru','\.rnd\.ru','\.ryazan\.ru','\.sakhalin\.ru','\.samara\.ru', '\.saratov\.ru','\.simbirsk\.ru','\.smolensk\.ru','\.spb\.ru','\.stavropol\.ru','\.stv\.ru', '\.surgut\.ru','\.tambov\.ru','\.tatarstan\.ru','\.tom\.ru','\.tomsk\.ru','\.tsaritsyn\.ru', '\.tsk\.ru','\.tula\.ru','\.tuva\.ru','\.tver\.ru','\.tyumen\.ru','\.udm\.ru','\.udmurtia\.ru','\.ulan-ude\.ru', '\.vladikavkaz\.ru','\.vladimir\.ru','\.vladivostok\.ru','\.volgograd\.ru','\.vologda\.ru', '\.voronezh\.ru','\.vrn\.ru','\.vyatka\.ru','\.yakutia\.ru','\.yamal\.ru','\.yekaterinburg\.ru', '\.yuzhno-sakhalinsk\.ru','\.ac\.rw','\.co\.rw','\.com\.rw','\.edu\.rw','\.gouv\.rw','\.gov\.rw', '\.int\.rw','\.mil\.rw','\.net\.rw','\.com\.sa','\.edu\.sa','\.gov\.sa','\.med\.sa','\.net\.sa', '\.org\.sa','\.pub\.sa','\.sch\.sa','\.com\.sd','\.edu\.sd','\.gov\.sd','\.info\.sd','\.med\.sd', '\.net\.sd','\.org\.sd','\.tv\.sd','\.a\.se','\.ac\.se','\.b\.se','\.bd\.se','\.c\.se','\.d\.se', '\.e\.se','\.f\.se','\.g\.se','\.h\.se','\.i\.se','\.k\.se','\.l\.se','\.m\.se','\.n\.se','\.o\.se', '\.org\.se','\.p\.se','\.parti\.se','\.pp\.se','\.press\.se','\.r\.se','\.s\.se','\.t\.se','\.tm\.se', '\.u\.se','\.w\.se','\.x\.se','\.y\.se','\.z\.se','\.com\.sg','\.edu\.sg','\.gov\.sg','\.idn\.sg', '\.net\.sg','\.org\.sg','\.per\.sg','\.art\.sn','\.com\.sn','\.edu\.sn','\.gouv\.sn','\.org\.sn', '\.perso\.sn','\.univ\.sn','\.com\.sy','\.edu\.sy','\.gov\.sy','\.mil\.sy','\.net\.sy','\.news\.sy', '\.org\.sy','\.ac\.th','\.co\.th','\.go\.th','\.in\.th','\.mi\.th','\.net\.th','\.or\.th','\.ac\.tj', '\.biz\.tj','\.co\.tj','\.com\.tj','\.edu\.tj','\.go\.tj','\.gov\.tj','\.info\.tj','\.int\.tj', '\.mil\.tj','\.name\.tj','\.net\.tj','\.nic\.tj','\.org\.tj','\.test\.tj','\.web\.tj','\.agrinet\.tn', '\.com\.tn','\.defense\.tn','\.edunet\.tn','\.ens\.tn','\.fin\.tn','\.gov\.tn','\.ind\.tn','\.info\.tn', '\.intl\.tn','\.mincom\.tn','\.nat\.tn','\.net\.tn','\.org\.tn','\.perso\.tn','\.rnrt\.tn','\.rns\.tn', '\.rnu\.tn','\.tourism\.tn','\.ac\.tz','\.co\.tz','\.go\.tz','\.ne\.tz','\.or\.tz','\.biz\.ua', '\.cherkassy\.ua','\.chernigov\.ua','\.chernovtsy\.ua','\.ck\.ua','\.cn\.ua','\.co\.ua','\.com\.ua', '\.crimea\.ua','\.cv\.ua','\.dn\.ua','\.dnepropetrovsk\.ua','\.donetsk\.ua','\.dp\.ua','\.edu\.ua', '\.gov\.ua','\.if\.ua','\.in\.ua','\.ivano-frankivsk\.ua','\.kh\.ua','\.kharkov\.ua','\.kherson\.ua', '\.khmelnitskiy\.ua','\.kiev\.ua','\.kirovograd\.ua','\.km\.ua','\.kr\.ua','\.ks\.ua','\.kv\.ua', '\.lg\.ua','\.lugansk\.ua','\.lutsk\.ua','\.lviv\.ua','\.me\.ua','\.mk\.ua','\.net\.ua','\.nikolaev\.ua', '\.od\.ua','\.odessa\.ua','\.org\.ua','\.pl\.ua','\.poltava\.ua','\.pp\.ua','\.rovno\.ua','\.rv\.ua', '\.sebastopol\.ua','\.sumy\.ua','\.te\.ua','\.ternopil\.ua','\.uzhgorod\.ua','\.vinnica\.ua','\.vn\.ua', '\.zaporizhzhe\.ua','\.zhitomir\.ua','\.zp\.ua','\.zt\.ua','\.ac\.ug','\.co\.ug','\.go\.ug','\.ne\.ug', '\.or\.ug','\.org\.ug','\.sc\.ug','\.ac\.uk','\.bl\.uk','\.british-library\.uk','\.co\.uk','\.cym\.uk', '\.gov\.uk','\.govt\.uk','\.icnet\.uk','\.jet\.uk','\.lea\.uk','\.ltd\.uk','\.me\.uk','\.mil\.uk', '\.mod\.uk','\.mod\.uk','\.national-library-scotland\.uk','\.nel\.uk','\.net\.uk','\.nhs\.uk', '\.nhs\.uk','\.nic\.uk','\.nls\.uk','\.org\.uk','\.orgn\.uk','\.parliament\.uk','\.parliament\.uk', '\.plc\.uk','\.police\.uk','\.sch\.uk','\.scot\.uk','\.soc\.uk','\.dni\.us','\.fed\.us','\.isa\.us', '\.kids\.us','\.nsn\.us','\.com\.uy','\.edu\.uy','\.gub\.uy','\.mil\.uy','\.net\.uy','\.org\.uy', '\.co\.ve','\.com\.ve','\.edu\.ve','\.gob\.ve','\.info\.ve','\.mil\.ve','\.net\.ve','\.org\.ve', '\.web\.ve','\.co\.vi','\.com\.vi','\.k12\.vi','\.net\.vi','\.org\.vi','\.ac\.vn','\.biz\.vn', '\.com\.vn','\.edu\.vn','\.gov\.vn','\.health\.vn','\.info\.vn','\.int\.vn','\.name\.vn','\.net\.vn', '\.org\.vn','\.pro\.vn','\.co\.ye','\.com\.ye','\.gov\.ye','\.ltd\.ye','\.me\.ye','\.net\.ye', '\.org\.ye','\.plc\.ye','\.ac\.yu','\.co\.yu','\.edu\.yu','\.gov\.yu','\.org\.yu','\.ac\.za', '\.agric\.za','\.alt\.za','\.bourse\.za','\.city\.za','\.co\.za','\.cybernet\.za','\.db\.za', '\.ecape\.school\.za','\.edu\.za','\.fs\.school\.za','\.gov\.za','\.gp\.school\.za','\.grondar\.za', '\.iaccess\.za','\.imt\.za','\.inca\.za','\.kzn\.school\.za','\.landesign\.za','\.law\.za', '\.lp\.school\.za','\.mil\.za','\.mpm\.school\.za','\.ncape\.school\.za','\.net\.za','\.ngo\.za', '\.nis\.za','\.nom\.za','\.nw\.school\.za','\.olivetti\.za','\.org\.za','\.pix\.za','\.school\.za', '\.tm\.za','\.wcape\.school\.za','\.web\.za','\.ac\.zm','\.co\.zm','\.com\.zm','\.edu\.zm','\.gov\.zm', '\.net\.zm','\.org\.zm','\.sch\.zm' ); my @TLD2 = ( '\.ac','\.ad','\.ae','\.af','\.ag','\.ai','\.al','\.am','\.ao','\.aq', '\.ar','\.as','\.at','\.au','\.aw','\.ax','\.az','\.ba','\.bb','\.bd', '\.be','\.bf','\.bg','\.bh','\.bi','\.bj','\.bm','\.bn','\.bo','\.br', '\.bs','\.bt','\.bw','\.by','\.bz','\.ca','\.cc','\.cd','\.cf','\.cg', '\.ch','\.ci','\.ck','\.cl','\.cm','\.cn','\.co','\.cr','\.cu','\.cv', '\.cw','\.cx','\.cy','\.cz','\.de','\.dj','\.dk','\.dm','\.do','\.dz', '\.ec','\.ee','\.eg','\.er','\.es','\.et','\.eu','\.fi','\.fj','\.fk', '\.fm','\.fo','\.fr','\.ga','\.gd','\.ge','\.gf','\.gg','\.gh','\.gi', '\.gl','\.gm','\.gn','\.gp','\.gq','\.gr','\.gs','\.gt','\.gu','\.gw', '\.gy','\.hk','\.hm','\.hn','\.hr','\.ht','\.hu','\.id','\.ie','\.il', '\.im','\.in','\.io','\.iq','\.ir','\.is','\.it','\.je','\.jm','\.jo', '\.jp','\.ke','\.kg','\.kh','\.ki','\.km','\.kn','\.kp','\.kr','\.kw', '\.ky','\.kz','\.la','\.lb','\.lc','\.li','\.lk','\.lr','\.ls','\.lt', '\.lu','\.lv','\.ly','\.ma','\.mc','\.md','\.me','\.mg','\.mh','\.mk', '\.ml','\.mm','\.mn','\.mo','\.mp','\.mq','\.mr','\.ms','\.mt','\.mu', '\.mv','\.mw','\.mx','\.my','\.mz','\.na','\.nc','\.ne','\.nf','\.ng', '\.ni','\.nl','\.no','\.np','\.nr','\.nu','\.nz','\.om','\.pa','\.pe', '\.pf','\.pg','\.ph','\.pk','\.pl','\.pm','\.pn','\.pr','\.ps','\.pt', '\.pw','\.py','\.qa','\.re','\.ro','\.rs','\.ru','\.rw','\.sa','\.sb', '\.sc','\.sd','\.se','\.sg','\.sh','\.si','\.sk','\.sl','\.sm','\.sn', '\.so','\.sr','\.ss','\.st','\.su','\.sv','\.sx','\.sy','\.sz','\.tc', '\.td','\.tf','\.tg','\.th','\.tj','\.tk','\.tl','\.tm','\.tn','\.to', '\.tr','\.tt','\.tv','\.tw','\.tz','\.ua','\.ug','\.uk','\.us','\.uy', '\.uz','\.va','\.vc','\.ve','\.vg','\.vi','\.vn','\.vu','\.wf','\.ws', '\.ye','\.za','\.zm','\.zw','\.com','\.info','\.net','\.org','\.biz', '\.name','\.pro','\.xxx','\.aero','\.asia','\.bzh','\.cat','\.coop', '\.edu','\.gov','\.int','\.jobs','\.mil','\.mobi','\.museum','\.paris', '\.sport','\.tel','\.travel','\.kids','\.mail','\.post','\.arpa','\.example', '\.invalid','\.localhost','\.test','\.bitnet','\.csnet','\.lan','\.local', '\.onion','\.root','\.uucp','\.tld','\.nato' ); sub new { my ($class, $conf_file, $log_file, $debug, $rebuild) = @_; # Construct the class my $self = {}; bless $self, $class; # Initialize all variables $self->_init($conf_file, $log_file, $debug, $rebuild); # Return the instance return($self); } sub localdie { my ($self, $msg) = @_; print STDERR "$msg"; unlink($self->{pidfile}) if (-e $self->{pidfile}); exit 1; } sub parseFile { my ($self) = @_; return if ((!-f $self->{LogFile}) || (-z $self->{LogFile})); # The log file format must be : # time elapsed client code/status bytes method URL rfc931 peerstatus/peerhost type # This is the default format of squid access log file. # Open logfile my $logfile = new IO::File; if ($self->{LogFile} =~ /\.gz/) { # Open a pipe to zcat program for compressed log $logfile->open("$ZCAT_PROG $self->{LogFile} |") || $self->localdie("ERROR: cannot read from pipe to $ZCAT_PROG $self->{LogFile}. $!\n"); } elsif ($self->{LogFile} =~ /\.bz2/) { # Open a pipe to zcat program for compressed log $logfile->open("$BZCAT_PROG $self->{LogFile} |") || $self->localdie("ERROR: cannot read from pipe to $BZCAT_PROG $self->{LogFile}. $!\n"); } else { $logfile->open($self->{LogFile}) || $self->localdie("ERROR: Unable to open Squid access.log file $self->{LogFile}. $!\n"); } my $line = ''; my $time = 0; my $elapsed = 0; my $client_ip = ''; my $client_name = ''; my $code = ''; my $bytes = 0; my $method = ''; my $url = ''; my $login = ''; my $status = ''; my $mime_type = ''; my $line_count = 0; my $line_processed_count = 0; my $line_stored_count = 0; # Read and parse each line of the access log file while ($line = <$logfile>) { chomp($line); #logformat squid %ts.%03tu %6tr %>a %Ss/%03>Hs %a %Ss/%03>Hs %h] [%a %ui %un [%tl] "%rm %ru HTTP/%rv" %>Hs %a %ui %un [%tl] "%rm %ru HTTP/%rv" %>Hs %h" "%{User-Agent}>h" %Ss:%Sh # Parse log with format: time elapsed client code/status bytes method URL rfc931 peerstatus/peerhost mime_type if ( $line =~ s#^(\d+\.\d{3})\s+(\d+)\s+([^\s]+)\s+([^\s]+)\s+(\d+)\s+([^\s]+)\s+## ) { $time = $1 || 0; $elapsed = $2 || 0; $client_ip = $3 || ''; $code = $4 || ''; $bytes = $5 || 0; $method = $6 || ''; # Do not parse some unwanted method next if (($#{$self->{ExcludedMethods}} >= 0) && grep(/^$method$/, @{$self->{ExcludedMethods}})); # Go to last parsed date (incremental mode) next if ($self->{history_time} && ($time <= $self->{history_time})); # Register the last parsing time $self->{end_time} = $time; # Register the first parsing time if (!$self->{begin_time}) { $self->{begin_time} = $time; print STDERR "START TIME: ", strftime("%a %b %e %H:%M:%S %Y", localtime($time)), "\n" if (!$self->{QuietMode}); } # Only store (HIT|UNMODIFIED)/MISS status and peer CD_SIBLING_HIT/ aswell as peer SIBLING_HIT/... if ( ($code =~ m#(HIT|UNMODIFIED)/#) || ($self->{SiblingHit} && ($line =~ / (CD_)?SIBLING_HIT/)) ) { $code = 'HIT'; } elsif ($code =~ m#MISS|MODIFIED/#) { $code = 'MISS'; } elsif ($code =~ m#DENIED/#) { $code = 'DENIED'; } else { next; } if ( $line =~ s#^(.*?)\s+([^\s]+)\s+([^\s]+\/[^\s]+)\s+([^\s]+)\s*## ) { $url = lc($1) || ''; $login = lc($2) || ''; $status = lc($3) || ''; $mime_type = lc($4) || ''; $mime_type = 'none' if (!$mime_type || ($mime_type eq '-')); # Do not parse some unwanted method next if (($#{$self->{ExcludedMimes}} >= 0) && map {$mime_type =~ m#^$_$#} @{$self->{ExcludedMimes}}); # Remove extra space character in username $login =~ s/\%20//g; # Set default user login to client ip address my $id = $client_ip || ''; if ($login ne '-') { $id = $login; } next if (!$id || !$bytes); my $found = 0; ##### # If there's some mandatory inclusion, check the entry against the definitions ##### if (exists $self->{Include}{users} || exists $self->{Include}{clients} || exists $self->{Include}{networks}) { # check for user inclusion if (exists $self->{Include}{users}) { foreach my $e (@{$self->{Include}{users}}) { if ($login =~ m#^$e$#i) { $found = 1; last; } } } # check for client inclusion if (exists $self->{Include}{clients}) { foreach my $e (@{$self->{Include}{clients}}) { if ($client_ip =~ m#^$e$#i) { $found = 1; last; } } } # check for Network inclusion if (exists $self->{Include}{networks}) { foreach my $e (@{$self->{Include}{networks}}) { if (&check_ip($client_ip, $e)) { $found = 1; last; } } } # The entry is not allowed in included file so skip it next if (!$found); $found = 0; } ##### # Check the entry against the exclusion definitions. The entry # is skipped directly when it match an exclusion definition. ##### # check for user exclusion if (exists $self->{Exclude}{users}) { foreach my $e (@{$self->{Exclude}{users}}) { if ($login =~ m#^$e$#i) { $found = 1; last; } } next if ($found); } # check for client exclusion if (exists $self->{Exclude}{clients}) { foreach my $e (@{$self->{Exclude}{clients}}) { if ($client_ip =~ m#^$e$#i) { $found = 1; last; } } next if ($found); } # check for Network exclusion if (exists $self->{Exclude}{networks}) { foreach my $e (@{$self->{Exclude}{networks}}) { if (&check_ip($client_ip, $e)) { $found = 1; last; } } next if ($found); } # check for URL exclusion if (exists $self->{Exclude}{uris}) { foreach my $e (@{$self->{Exclude}{uris}}) { if ($url =~ m#^$e$#i) { $found = 1; last; } } next if ($found); } # Anonymize all users if ($self->{AnonymizeLogin} && ($client_ip ne $id)) { if (!exists $self->{AnonymizedId}{$id}) { $self->{AnonymizedId}{$id} = &anonymize_id(); } $id = $self->{AnonymizedId}{$id}; } # Now parse data and generate statistics $self->_parseData($time, $elapsed, $client_ip, $code, $bytes, $url, $id, $mime_type); $line_stored_count++; } $line_processed_count++; } $line_count++; } $logfile->close(); if (!$self->{last_year} && !$self->{last_month} && !$self->{last_day}) { print STDERR "No new log registered...\n" if (!$self->{QuietMode}); } else { print STDERR "\nParsing ended, generating last day data files...\n" if (!$self->{QuietMode}); # Save last parsed data $self->_save_data("$self->{last_year}", "$self->{last_month}", "$self->{last_day}"); if (!$self->{QuietMode}) { print STDERR "END TIME : ", strftime("%a %b %e %H:%M:%S %Y", localtime($self->{end_time})), "\n"; print STDERR "Read $line_count lines, matched $line_processed_count and found $line_stored_count new lines\n"; } # Set the current start time into history file if ($self->{end_time}) { my $current = new IO::File; $current->open(">$self->{Output}/SquidAnalyzer.current") or $self->localdie("Error: Can't write to file $self->{Output}/SquidAnalyzer.current, $!\n"); print $current "$self->{end_time}"; $current->close; } # Compute week statistics $self->_clear_stats(); if (!$self->{QuietMode}) { print STDERR "Generating weekly data files now...\n"; } my $wn = &get_week_number("$self->{last_year}", "$self->{last_month}", "$self->{last_day}"); my @wd = &get_wdays_per_month($wn, "$self->{last_year}-$self->{last_month}"); $wn++; print STDERR "Compute and dump weekly statistics for week $wn on $self->{last_year}\n" if (!$self->{QuietMode}); $self->_save_data("$self->{last_year}", "$self->{last_month}", "$self->{last_day}", sprintf("%02d", $wn), @wd); # Compute month statistics $self->_clear_stats(); if (!$self->{QuietMode}) { print STDERR "Generating monthly data files now...\n"; } for my $date ("$self->{first_year}$self->{first_month}" .. "$self->{last_year}$self->{last_month}") { $date =~ /^(\d{4})(\d{2})$/; next if (($2 < 1) || ($2 > 12)); print STDERR "Compute and dump month statistics for $1/$2\n" if (!$self->{QuietMode}); if (-d "$self->{Output}/$1/$2") { $self->_save_data("$1", "$2"); } } # Compute year statistics $self->_clear_stats(); if (!$self->{no_year_stat}) { if (!$self->{QuietMode}) { print STDERR "Compute and dump year statistics for $self->{first_year} to $self->{last_year}\n"; } for my $year ($self->{first_year} .. $self->{last_year}) { if (-d "$self->{Output}/$year") { $self->_save_data($year); } } } } } sub _clear_stats { my $self = shift; # Hashes to store user statistics $self->{stat_user_hour} = (); $self->{stat_user_day} = (); $self->{stat_user_month} = (); $self->{stat_usermax_hour} = (); $self->{stat_usermax_day} = (); $self->{stat_usermax_month} = (); $self->{stat_user_url_hour} = (); $self->{stat_user_url_day} = (); $self->{stat_user_url_month} = (); # Hashes to store network statistics $self->{stat_network_hour} = (); $self->{stat_network_day} = (); $self->{stat_network_month} = (); $self->{stat_netmax_hour} = (); $self->{stat_netmax_day} = (); $self->{stat_netmax_month} = (); # Hashes to store user / network statistics $self->{stat_netuser_hour} = (); $self->{stat_netuser_day} = (); $self->{stat_netuser_month} = (); # Hashes to store cache status (hit/miss) $self->{stat_code_hour} = (); $self->{stat_code_day} = (); $self->{stat_code_month} = (); # Hashes to store mime type $self->{stat_mime_type_hour} = (); $self->{stat_mime_type_day} = (); $self->{stat_mime_type_month} = (); } sub _init { my ($self, $conf_file, $log_file, $debug, $rebuild, $pidfile) = @_; # Prevent for a call without instance if (!ref($self)) { print STDERR "ERROR - init : Unable to call init without an object instance.\n"; unlink("$pidfile"); exit(0); } # Load configuration information if (!$conf_file) { if (-f '/etc/squidanalyzer.conf') { $conf_file = '/etc/squidanalyzer.conf'; } elsif (-f 'squidanalyzer.conf') { $conf_file = 'squidanalyzer.conf'; } } my %options = $self->parse_config($conf_file, $log_file, $rebuild); # Configuration options $self->{MinPie} = $options{MinPie} || 2; $self->{QuietMode} = $options{QuietMode} || 0; $self->{UrlReport} = $options{UrlReport} || 0; $self->{Output} = $options{Output} || ''; $self->{WebUrl} = $options{WebUrl} || ''; $self->{WebUrl} .= '/' if ($self->{WebUrl} && ($self->{WebUrl} !~ /\/$/)); $self->{DateFormat} = $options{DateFormat} || '%y-%m-%d'; $self->{Lang} = $options{Lang} || ''; $self->{AnonymizeLogin} = $options{AnonymizeLogin} || 0; $self->{SiblingHit} = $options{SiblingHit} || 1; $self->{ImgFormat} = $options{ImgFormat} || 'png'; $self->{Locale} = $options{Locale} || ''; $self->{WriteDelay} = $options{WriteDelay} || 3600; $self->{TopUrlUser} = $options{TopUrlUser} || 0; $self->{no_year_stat} = 0; $self->{UseClientDNSName} = $options{UseClientDNSName} || 0; $self->{DNSLookupTimeout} = $options{DNSLookupTimeout} || 0.0001; $self->{DNSLookupTimeout} = int($self->{DNSLookupTimeout} * 1000000); $self->{pidfile} = $pidfile || '/tmp/squid-analyzer.pid'; $self->{CustomHeader} = $options{CustomHeader} || qq{ SquidAnalyzer}; $self->{ExcludedMethods} = (); if ($options{ExcludedMethods}) { push(@{$self->{ExcludedMethods}}, split(/\s*,\s*/, $options{ExcludedMethods})); } $self->{ExcludedMimes} = (); if ($options{ExcludedMimes}) { push(@{$self->{ExcludedMimes}}, split(/\s*,\s*/, $options{ExcludedMimes})); } if ($self->{Lang}) { open(IN, "$self->{Lang}") or die "ERROR: can't open translation file $self->{Lang}, $!\n"; while (my $l = ) { chomp($l); $l =~ s/\r//gs; next if ($l =~ /^[\s\t]*#/); next if (!$l); my ($key, $str) = split(/\t+/, $l); $Translate{$key} = $str; } close(IN); } if (!$self->{Output}) { die "ERROR: 'Output' configuration option must be set.\n"; } if (! -d $self->{Output}) { die "ERROR: 'Output' directory $self->{Output} doesn't exists.\n"; } $self->{LogFile} = $options{LogFile} || '/var/log/squid/access.log'; if (!$self->{LogFile}) { die "ERROR: 'LogFile' configuration option must be set.\n"; } $self->{OrderUser} = lc($options{OrderUser}) || 'bytes'; $self->{OrderNetwork} = lc($options{OrderNetwork}) || 'bytes'; $self->{OrderUrl} = lc($options{OrderUrl}) || 'bytes'; $self->{OrderMime} = lc($options{OrderMime}) || 'bytes'; if ($self->{OrderUser} !~ /^(hits|bytes|duration)$/) { die "ERROR: OrderUser must be one of these values: hits, bytes or duration\n"; } if ($self->{OrderNetwork} !~ /^(hits|bytes|duration)$/) { die "ERROR: OrderNetwork must be one of these values: hits, bytes or duration\n"; } if ($self->{OrderUrl} !~ /^(hits|bytes|duration)$/) { die "ERROR: OrderUrl must be one of these values: hits, bytes or duration\n"; } if ($self->{OrderMime} !~ /^(hits|bytes)$/) { die "ERROR: OrderMime must be one of these values: hits or bytes\n"; } %{$self->{NetworkAlias}} = $self->parse_network_aliases($options{NetworkAlias} || ''); %{$self->{UserAlias}} = $self->parse_user_aliases($options{UserAlias} || ''); %{$self->{Exclude}} = $self->parse_exclusion($options{Exclude} || ''); %{$self->{Include}} = $self->parse_inclusion($options{Include} || ''); $self->{CostPrice} = $options{CostPrice} || 0; $self->{Currency} = $options{Currency} || '€'; $self->{TopNumber} = $options{TopNumber} || 10; $self->{TransfertUnit} = $options{TransfertUnit} || 'BYTES'; if (!grep(/^$self->{TransfertUnit}$/i, 'BYTES', 'KB', 'MB', 'GB')) { die "ERROR: TransfertUnit must be one of these values: KB, MB or GB\n"; } else { if (uc($self->{TransfertUnit}) eq 'BYTES') { $self->{TransfertUnitValue} = 1; $self->{TransfertUnit} = 'Bytes'; } elsif (uc($self->{TransfertUnit}) eq 'KB') { $self->{TransfertUnitValue} = 1024; } elsif (uc($self->{TransfertUnit}) eq 'MB') { $self->{TransfertUnitValue} = 1024*1024; } elsif (uc($self->{TransfertUnit}) eq 'GB') { $self->{TransfertUnitValue} = 1024*1024*1024; } } # Init statistics storage hashes $self->_clear_stats(); # Used to store the first and last date parsed $self->{last_year} = 0; $self->{last_month} = 0; $self->{last_day} = 0; $self->{first_year} = 0; $self->{first_month} = 0; $self->{begin_time} = 0; $self->{end_time} = 0; # Used to stored command line parameters from squid-analyzer $self->{history_time} = 0; $self->{preserve} = 0; # Override verbose mode $self->{QuietMode} = 0 if ($debug); # Enable local date format if defined, else strftime will be used. The limitation # this behavior is that all dates in HTML files will be the same for performences reasons. if ($self->{Locale}) { my $lang = 'LANG=' . $self->{Locale}; $self->{start_date} = `$lang date | iconv -t $Translate{CharSet} 2>/dev/null`; chomp($self->{start_date}); } # Get the last parsing date for incremental parsing if (!$rebuild && -e "$self->{Output}/SquidAnalyzer.current") { my $current = new IO::File; unless($current->open("$self->{Output}/SquidAnalyzer.current")) { print STDERR "ERROR: Can't read file $self->{Output}/SquidAnalyzer.current, $!\n" if (!$self->{QuietMode}); print STDERR "Starting at the first line of Squid access log file.\n" if (!$self->{QuietMode}); } else { $self->{history_time} = <$current>; chomp($self->{history_time}); $self->{begin_time} = $self->{history_time}; $current->close(); print STDERR "HISTORY TIME: ", strftime("%a %b %e %H:%M:%S %Y", localtime($self->{history_time})), "\n" if (!$self->{QuietMode}); } } $self->{menu} = qq{ }; $self->{menu2} = qq{ }; $self->{menu3} = qq{ }; } sub _gethostbyaddr { my ($self, $ip) = @_; my $host = undef; unless(exists $CACHE{$ip}) { eval { local $SIG{ALRM} = sub { die "DNS lookup timeout.\n"; }; ualarm $self->{DNSLookupTimeout}; $host = gethostbyaddr(inet_aton($ip), AF_INET); ualarm 0; }; if ($@) { $CACHE{$ip} = undef; #printf "_gethostbyaddr timeout : %s\n", $ip; } else { $CACHE{$ip} = $host; #printf "_gethostbyaddr success : %s (%s)\n", $ip, $host; } } return $CACHE{$ip} || $ip; } sub _parseData { my ($self, $time, $elapsed, $client, $code, $bytes, $url, $id, $type) = @_; # Save original IP address for dns resolving my $client_ip_addr = $client; # Get the current year and month my ($sec,$min,$hour,$day,$month,$year,$wday,$yday,$isdst) = localtime($time); $year += 1900; $month = sprintf("%02d", $month + 1); $day = sprintf("%02d", $day); # Store data when day change to save history if ($self->{last_year}) { if ("$year$month$day" ne "$self->{last_year}$self->{last_month}$self->{last_day}") { $self->{tmp_saving} = $time; # If the day has changed then we want to save stats of the previous one $self->_save_data($self->{last_year}, $self->{last_month}, $self->{last_day}); # Stats can be cleared print STDERR "Clearing statistics storage hashes.\n" if (!$self->{QuietMode}); $self->_clear_stats(); if (!$self->{QuietMode}) { print STDERR "Generating weekly data files...\n"; } my $wn = &get_week_number("$self->{last_year}", "$self->{last_month}", "$self->{last_day}"); my @wd = &get_wdays_per_month($wn, "$self->{last_year}-$self->{last_month}"); $wn++; print STDERR "Compute and dump weekly statistics for week $wn on $self->{last_year}\n" if (!$self->{QuietMode}); $self->_save_data("$self->{last_year}", "$self->{last_month}", "$self->{last_day}", sprintf("%02d", $wn), @wd); $self->_clear_stats(); } } # Extract the domainname part of the URL my $dest = $url; $dest =~ s#^[^\/]*\/\/##; $dest =~ s#\/.*##; $dest =~ s#:\d+$##; # Replace username by his dnsname if there's no username # (login is equal to ip) and if client is an ip address if ( ($id eq $client) && $self->{UseClientDNSName}) { if ($client =~ /^\d+\.\d+\.\d+\.\d+$/) { my $dnsname = $self->_gethostbyaddr($client); if ($dnsname) { $id = $dnsname; } } } # Replace network by his aliases if any my $network = ''; foreach my $r (keys %{$self->{NetworkAlias}}) { if ($r =~ /^\d+\.\d+\.\d+\.\d+\/\d+$/) { if (&check_ip($client, $r)) { $network = $self->{NetworkAlias}->{$r}; last; } } elsif ($client =~ /^$r/) { $network = $self->{NetworkAlias}->{$r}; last; } } # Set default to a class A network if (!$network) { $network = $client; $network =~ s/\.\d+$/\.0/; } # Replace username by his alias if any foreach my $u (keys %{$self->{UserAlias}}) { if ( $id =~ /^$u$/i ) { $id = $self->{UserAlias}->{$u}; last; } } # Store data when hour change to save memory if ($self->{tmp_saving} && ($time > ($self->{tmp_saving} + $self->{WriteDelay})) ) { $self->{tmp_saving} = $time; # If the day has changed then we want to save stats of the previous one $self->_save_data($self->{last_year}, $self->{last_month}, $self->{last_day}); # Stats can be cleared print STDERR "Clearing statistics storage hashes.\n" if (!$self->{QuietMode}); $self->_clear_stats(); } # Stores last parsed date part $self->{last_year} = $year; $self->{last_month} = $month; $self->{last_day} = $day; $hour = sprintf("%02d", $hour); # Stores first parsed date part $self->{first_year} ||= $self->{last_year}; $self->{first_month} ||= $self->{last_month}; $self->{tmp_saving} = $time if (!$self->{tmp_saving}); #### Store access denied statistics if ($code eq 'DENIED') { $self->{stat_code_hour}{$code}{$hour}{hits}++; $self->{stat_code_hour}{$code}{$hour}{bytes} += $bytes; $self->{stat_code_day}{$code}{$self->{last_day}}{hits}++; $self->{stat_code_day}{$code}{$self->{last_day}}{bytes} += $bytes; return; } #### Store client statistics $self->{stat_user_hour}{$id}{$hour}{hits}++; $self->{stat_user_hour}{$id}{$hour}{bytes} += $bytes; $self->{stat_user_hour}{$id}{$hour}{duration} += $elapsed; $self->{stat_user_day}{$id}{$self->{last_day}}{hits}++; $self->{stat_user_day}{$id}{$self->{last_day}}{bytes} += $bytes; $self->{stat_user_day}{$id}{$self->{last_day}}{duration} += $elapsed; if ($bytes > $self->{stat_usermax_hour}{$id}{largest_file_size}) { $self->{stat_usermax_hour}{$id}{largest_file_size} = $bytes; $self->{stat_usermax_hour}{$id}{largest_file_url} = $url; } if ($bytes > $self->{stat_usermax_day}{$id}{largest_file_size}) { $self->{stat_usermax_day}{$id}{largest_file_size} = $bytes; $self->{stat_usermax_day}{$id}{largest_file_url} = $url; } #### Store networks statistics $self->{stat_network_hour}{$network}{$hour}{hits}++; $self->{stat_network_hour}{$network}{$hour}{bytes} += $bytes; $self->{stat_network_hour}{$network}{$hour}{duration} += $elapsed; $self->{stat_network_day}{$network}{$self->{last_day}}{hits}++; $self->{stat_network_day}{$network}{$self->{last_day}}{bytes} += $bytes; $self->{stat_network_day}{$network}{$self->{last_day}}{duration} += $elapsed; if ($bytes > $self->{stat_netmax_hour}{$network}{largest_file_size}) { $self->{stat_netmax_hour}{$network}{largest_file_size} = $bytes; $self->{stat_netmax_hour}{$network}{largest_file_url} = $url; } if ($bytes > $self->{stat_netmax_day}{$network}{largest_file_size}) { $self->{stat_netmax_day}{$network}{largest_file_size} = $bytes; $self->{stat_netmax_day}{$network}{largest_file_url} = $url; } #### Store HIT/MISS statistics $self->{stat_code_hour}{$code}{$hour}{hits}++; $self->{stat_code_hour}{$code}{$hour}{bytes} += $bytes; $self->{stat_code_day}{$code}{$self->{last_day}}{hits}++; $self->{stat_code_day}{$code}{$self->{last_day}}{bytes} += $bytes; #### Store url statistics if ($self->{UrlReport}) { $self->{stat_user_url_hour}{$id}{$dest}{duration} += $elapsed; $self->{stat_user_url_hour}{$id}{$dest}{hits}++; $self->{stat_user_url_hour}{$id}{$dest}{bytes} += $bytes; $self->{stat_user_url_hour}{$id}{$dest}{firsthit} = $time if (!$self->{stat_user_url_hour}{$id}{$dest}{firsthit} || ($time < $self->{stat_user_url_hour}{$id}{$dest}{firsthit})); $self->{stat_user_url_hour}{$id}{$dest}{lasthit} = $time if (!$self->{stat_user_url_hour}{$id}{$dest}{lasthit} || ($time > $self->{stat_user_url_hour}{$id}{$dest}{lasthit})); $self->{stat_user_url_day}{$id}{$dest}{duration} += $elapsed; $self->{stat_user_url_day}{$id}{$dest}{hits}++; $self->{stat_user_url_day}{$id}{$dest}{firsthit} = $time if (!$self->{stat_user_url_day}{$id}{$dest}{firsthit} || ($time < $self->{stat_user_url_day}{$id}{$dest}{firsthit})); $self->{stat_user_url_day}{$id}{$dest}{lasthit} = $time if (!$self->{stat_user_url_day}{$id}{$dest}{lasthit} || ($time > $self->{stat_user_url_day}{$id}{$dest}{lasthit})); $self->{stat_user_url_day}{$id}{$dest}{bytes} += $bytes; if ($code eq 'HIT') { $self->{stat_user_url_day}{$id}{$dest}{cache_hit}++; $self->{stat_user_url_day}{$id}{$dest}{cache_bytes} += $bytes; } } #### Store user per networks statistics $self->{stat_netuser_hour}{$network}{$id}{duration} += $elapsed; $self->{stat_netuser_hour}{$network}{$id}{bytes} += $bytes; $self->{stat_netuser_hour}{$network}{$id}{hits}++; if ($bytes > $self->{stat_netuser_hour}{$network}{$id}{largest_file_size}) { $self->{stat_netuser_hour}{$network}{$id}{largest_file_size} = $bytes; $self->{stat_netuser_hour}{$network}{$id}{largest_file_url} = $url; } $self->{stat_netuser_day}{$network}{$id}{duration} += $elapsed; $self->{stat_netuser_day}{$network}{$id}{bytes} += $bytes; $self->{stat_netuser_day}{$network}{$id}{hits}++; if ($bytes > $self->{stat_netuser_day}{$network}{$id}{largest_file_size}) { $self->{stat_netuser_day}{$network}{$id}{largest_file_size} = $bytes; $self->{stat_netuser_day}{$network}{$id}{largest_file_url} = $url; } #### Store mime type statistics $self->{stat_mime_type_hour}{"$type"}{hits}++; $self->{stat_mime_type_hour}{"$type"}{bytes} += $bytes; $self->{stat_mime_type_day}{"$type"}{hits}++; $self->{stat_mime_type_day}{"$type"}{bytes} += $bytes; } sub _save_stat { my ($self, $year, $month, $day, $wn, @wd) = @_; my $type = 'hour'; if (!$day) { $type = 'day'; } if ($wn) { $type = 'week'; } if (!$month) { $type = 'month'; } my $path = join('/', $year, $month, $day); $path =~ s/[\/]+$//; #### Load history if we are not rebuilding a particular day if ($type eq 'day') { foreach my $d ("01" .. "31") { $self->_read_stat($year, $month, $d, 'day'); } } elsif ($type eq 'week') { $path = "$year/week$wn"; foreach my $wdate (@wd) { $wdate =~ /^(\d+)-(\d+)-(\d+)$/; $self->_read_stat($1, $2, $3, 'day', $wn); } $type = 'day'; } elsif ($type eq 'month') { foreach my $m ("01" .. "12") { $self->_read_stat($year, $m, $day, 'month'); } } else { $self->_read_stat($year, $month, $day); } print STDERR "Dumping data into $self->{Output}/$path\n" if (!$self->{QuietMode}); #### Save url statistics per user if ($self->{UrlReport}) { my $dat_file_user_url = new IO::File; $dat_file_user_url->open(">$self->{Output}/$path/stat_user_url.dat") or $self->localdie("ERROR: Can't write to file $self->{Output}/$path/stat_user_url.dat, $!\n"); foreach my $id (sort {$a cmp $b} keys %{$self->{"stat_user_url_$type"}}) { foreach my $dest (keys %{$self->{"stat_user_url_$type"}{$id}}) { $dat_file_user_url->print( "$id hits=" . $self->{"stat_user_url_$type"}{$id}{$dest}{hits} . ";" . "bytes=" . $self->{"stat_user_url_$type"}{$id}{$dest}{bytes} . ";" . "duration=" . $self->{"stat_user_url_$type"}{$id}{$dest}{duration} . ";" . "first=" . $self->{"stat_user_url_$type"}{$id}{$dest}{firsthit} . ";" . "last=" . $self->{"stat_user_url_$type"}{$id}{$dest}{lasthit} . ";" . "url=$dest;" . "cache_hit=" . ($self->{"stat_user_url_$type"}{$id}{$dest}{cache_hit}||0) . ";" . "cache_bytes=" . ($self->{"stat_user_url_$type"}{$id}{$dest}{cache_bytes}||0) . "\n"); } } $dat_file_user_url->close(); $self->{"stat_user_url_$type"} = (); } #### Save user statistics my $dat_file_user = new IO::File; $dat_file_user->open(">$self->{Output}/$path/stat_user.dat") or $self->localdie("ERROR: Can't write to file $self->{Output}/$path/stat_user.dat, $!\n"); foreach my $id (sort {$a cmp $b} keys %{$self->{"stat_user_$type"}}) { my $name = $id; $name =~ s/\s+//g; $dat_file_user->print("$name hits_$type="); foreach my $tmp (sort {$a <=> $b} keys %{$self->{"stat_user_$type"}{$id}}) { $dat_file_user->print("$tmp:" . $self->{"stat_user_$type"}{$id}{$tmp}{hits} . ","); } $dat_file_user->print(";bytes_$type="); foreach my $tmp (sort {$a <=> $b} keys %{$self->{"stat_user_$type"}{$id}}) { $dat_file_user->print("$tmp:" . $self->{"stat_user_$type"}{$id}{$tmp}{bytes} . ","); } $dat_file_user->print(";duration_$type="); foreach my $tmp (sort {$a <=> $b} keys %{$self->{"stat_user_$type"}{$id}}) { $dat_file_user->print("$tmp:" . $self->{"stat_user_$type"}{$id}{$tmp}{duration} . ","); } $dat_file_user->print(";largest_file_size=" . $self->{"stat_usermax_$type"}{$id}{largest_file_size}); $dat_file_user->print(";largest_file_url=" . $self->{"stat_usermax_$type"}{$id}{largest_file_url} . "\n"); } $dat_file_user->close(); $self->{"stat_user_$type"} = (); $self->{"stat_usermax_$type"} = (); #### Save network statistics my $dat_file_network = new IO::File; $dat_file_network->open(">$self->{Output}/$path/stat_network.dat") or $self->localdie("ERROR: Can't write to file $self->{Output}/$path/stat_network.dat, $!\n"); foreach my $net (sort {$a cmp $b} keys %{$self->{"stat_network_$type"}}) { $dat_file_network->print("$net\thits_$type="); foreach my $tmp (sort {$a <=> $b} keys %{$self->{"stat_network_$type"}{$net}}) { $dat_file_network->print("$tmp:" . $self->{"stat_network_$type"}{$net}{$tmp}{hits} . ","); } $dat_file_network->print(";bytes_$type="); foreach my $tmp (sort {$a <=> $b} keys %{$self->{"stat_network_$type"}{$net}}) { $dat_file_network->print("$tmp:" . $self->{"stat_network_$type"}{$net}{$tmp}{bytes} . ","); } $dat_file_network->print(";duration_$type="); foreach my $tmp (sort {$a <=> $b} keys %{$self->{"stat_network_$type"}{$net}}) { $dat_file_network->print("$tmp:" . $self->{"stat_network_$type"}{$net}{$tmp}{duration} . ","); } $dat_file_network->print(";largest_file_size=" . $self->{"stat_netmax_$type"}{$net}{largest_file_size}); $dat_file_network->print(";largest_file_url=" . $self->{"stat_netmax_$type"}{$net}{largest_file_url} . "\n"); } $dat_file_network->close(); $self->{"stat_network_$type"} = (); $self->{"stat_netmax_$type"} = (); #### Save user per network statistics my $dat_file_netuser = new IO::File; $dat_file_netuser->open(">$self->{Output}/$path/stat_netuser.dat") or $self->localdie("ERROR: Can't write to file $self->{Output}/$path/stat_netuser.dat, $!\n"); foreach my $net (sort {$a cmp $b} keys %{$self->{"stat_netuser_$type"}}) { foreach my $id (sort {$a cmp $b} keys %{$self->{"stat_netuser_$type"}{$net}}) { $dat_file_netuser->print("$net\t$id\thits=" . $self->{"stat_netuser_$type"}{$net}{$id}{hits} . ";" . "bytes=" . $self->{"stat_netuser_$type"}{$net}{$id}{bytes} . ";" . "duration=" . $self->{"stat_netuser_$type"}{$net}{$id}{duration} . ";"); $dat_file_netuser->print("largest_file_size=" . $self->{"stat_netuser_$type"}{$net}{$id}{largest_file_size} . ";" . "largest_file_url=" . $self->{"stat_netuser_$type"}{$net}{$id}{largest_file_url} . "\n"); } } $dat_file_netuser->close(); $self->{"stat_netuser_$type"} = (); #### Save cache statistics my $dat_file_code = new IO::File; $dat_file_code->open(">$self->{Output}/$path/stat_code.dat") or $self->localdie("ERROR: Can't write to file $self->{Output}/$path/stat_code.dat, $!\n"); foreach my $code (sort {$a cmp $b} keys %{$self->{"stat_code_$type"}}) { $dat_file_code->print("$code " . "hits_$type="); foreach my $tmp (sort {$a <=> $b} keys %{$self->{"stat_code_$type"}{$code}}) { $dat_file_code->print("$tmp:" . $self->{"stat_code_$type"}{$code}{$tmp}{hits} . ","); } $dat_file_code->print(";bytes_$type="); foreach my $tmp (sort {$a <=> $b} keys %{$self->{"stat_code_$type"}{$code}}) { $dat_file_code->print("$tmp:" . $self->{"stat_code_$type"}{$code}{$tmp}{bytes} . ","); } $dat_file_code->print("\n"); } $dat_file_code->close(); $self->{"stat_code_$type"} = (); $self->{stat_code} = (); #### Save mime statistics my $dat_file_mime_type = new IO::File; $dat_file_mime_type->open(">$self->{Output}/$path/stat_mime_type.dat") or $self->localdie("ERROR: Can't write to file $self->{Output}/$path/stat_mime_type.dat, $!\n"); foreach my $mime (sort {$a cmp $b} keys %{$self->{"stat_mime_type_$type"}}) { $dat_file_mime_type->print("$mime hits=" . $self->{"stat_mime_type_$type"}{$mime}{hits} . ";" . "bytes=" . $self->{"stat_mime_type_$type"}{$mime}{bytes} . "\n"); } $dat_file_mime_type->close(); $self->{"stat_mime_type_$type"} = (); } sub _save_data { my ($self, $year, $month, $day, $wn, @wd) = @_; #### Create directory structure if (!-d "$self->{Output}/$year") { mkdir("$self->{Output}/$year", 0755) || $self->localdie("ERROR: can't create directory $self->{Output}/$year, $!\n"); } if ($month && !-d "$self->{Output}/$year/$month") { mkdir("$self->{Output}/$year/$month", 0755) || $self->localdie("ERROR: can't create directory $self->{Output}/$year/$month, $!\n"); } if ($day && !-d "$self->{Output}/$year/$month/$day") { mkdir("$self->{Output}/$year/$month/$day", 0755) || $self->localdie("ERROR: can't create directory $self->{Output}/$year/$month/$day, $!\n"); } if ($wn && !-d "$self->{Output}/$year/week$wn") { mkdir("$self->{Output}/$year/week$wn", 0755) || $self->localdie("ERROR: can't create directory $self->{Output}/$year/week$wn, $!\n"); } # Dumping data $self->_save_stat($year, $month, $day, $wn, @wd); } sub _read_stat { my ($self, $year, $month, $day, $sum_type, $wn) = @_; my $type = 'hour'; if (!$day) { $type = 'day'; } if (!$month) { $type = 'month'; } my $path = join('/', $year, $month, $day); $path =~ s/[\/]+$//; return if (! -d "$self->{Output}/$path"); print STDERR "Reading data from previous dat files in $self->{Output}/$path/\n" if (!$self->{QuietMode}); my $k = ''; my $key = ''; $key = $day if ($sum_type eq 'day'); $key = $month if ($sum_type eq 'month'); $sum_type ||= $type; #### Read previous client statistics my $dat_file_user = new IO::File; if ($dat_file_user->open("$self->{Output}/$path/stat_user.dat")) { my $i = 1; while (my $l = <$dat_file_user>) { chomp($l); if ($l =~ s/^([^\s]+)\s+hits_$type=([^;]+);bytes_$type=([^;]+);duration_$type=([^;]+);largest_file_size=([^;]*);largest_file_url=(.*)$//) { my $id = $1; my $hits = $2 || ''; my $bytes = $3 || ''; my $duration = $4 || ''; if ($5 > $self->{"stat_usermax_$sum_type"}{$id}{largest_file_size}) { $self->{"stat_usermax_$sum_type"}{$id}{largest_file_size} = $5; $self->{"stat_usermax_$sum_type"}{$id}{largest_file_url} = $6; } $hits =~ s/,$//; $bytes =~ s/,$//; $duration =~ s/,$//; my %hits_tmp = split(/[:,]/, $hits); foreach my $tmp (sort {$a <=> $b} keys %hits_tmp) { if ($key ne '') { $k = $key; } else { $k = $tmp; } $self->{"stat_user_$sum_type"}{$id}{$k}{hits} += $hits_tmp{$tmp}; } my %bytes_tmp = split(/[:,]/, $bytes); foreach my $tmp (sort {$a <=> $b} keys %bytes_tmp) { if ($key ne '') { $k = $key; } else { $k = $tmp; } $self->{"stat_user_$sum_type"}{$id}{$k}{bytes} += $bytes_tmp{$tmp}; } my %duration_tmp = split(/[:,]/, $duration); foreach my $tmp (sort {$a <=> $b} keys %duration_tmp) { if ($key ne '') { $k = $key; } else { $k = $tmp; } $self->{"stat_user_$sum_type"}{$id}{$k}{duration} += $duration_tmp{$tmp}; } } else { print STDERR "ERROR: bad format at line $i into $self->{Output}/$path/stat_user.dat:\n"; print STDERR "$l\n"; unlink($self->{pidfile}); exit 0; } $i++; } $dat_file_user->close(); } #### Read previous url statistics if ($self->{UrlReport}) { my $dat_file_user_url = new IO::File; if ($dat_file_user_url->open("$self->{Output}/$path/stat_user_url.dat")) { my $i = 1; while (my $l = <$dat_file_user_url>) { chomp($l); if ($l =~ s/^([^\s]+)\s+hits=(\d+);bytes=(\d+);duration=(\d+);first=([^;]*);last=([^;]*);url=(.*?);cache_hit=(\d*);cache_bytes=(\d*)//) { $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{hits} += $2; $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{bytes} += $3; $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{duration} += $4; $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{firsthit} = $5 if (!$self->{"stat_user_url_$sum_type"}{$1}{"$7"}{firsthit} || ($5 < $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{firsthit})); $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{lasthit} = $6 if (!$self->{"stat_user_url_$sum_type"}{$1}{"$7"}{lasthit} || ($6 > $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{lasthit})); $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{cache_hit} += $8; $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{cache_bytes} += $9; } elsif ($l =~ s/^([^\s]+)\s+hits=(\d+);bytes=(\d+);duration=(\d+);first=([^;]*);last=([^;]*);url=(.*)$//) { $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{hits} += $2; $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{bytes} += $3; $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{duration} += $4; $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{firsthit} = $5 if (!$self->{"stat_user_url_$sum_type"}{$1}{"$7"}{firsthit} || ($5 < $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{firsthit})); $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{lasthit} = $6 if (!$self->{"stat_user_url_$sum_type"}{$1}{"$7"}{lasthit} || ($6 > $self->{"stat_user_url_$sum_type"}{$1}{"$7"}{lasthit})); } elsif ($l =~ s/^([^\s]+)\s+hits=(\d+);bytes=(\d+);duration=(\d+);url=(.*)$//) { $self->{"stat_user_url_$sum_type"}{$1}{"$5"}{hits} += $2; $self->{"stat_user_url_$sum_type"}{$1}{"$5"}{bytes} += $3; $self->{"stat_user_url_$sum_type"}{$1}{"$5"}{duration} += $4; } else { print STDERR "ERROR: bad format at line $i into $self->{Output}/$path/stat_user_url.dat\n"; print STDERR "$l\n"; unlink($self->{pidfile}); exit 0; } $i++; } $dat_file_user_url->close(); } } #### Read previous network statistics my $dat_file_network = new IO::File; if ($dat_file_network->open("$self->{Output}/$path/stat_network.dat")) { my $i = 1; while (my $l = <$dat_file_network>) { chomp($l); my ($net, $data) = split(/\t/, $l); if (!$data) { # Assume backward compatibility $l =~ s/^(.*)\shits_$type=/hits_$type=/; $net = $1; $data = $l; } if ($data =~ s/^hits_$type=([^;]+);bytes_$type=([^;]+);duration_$type=([^;]+);largest_file_size=([^;]*);largest_file_url=(.*)$//) { my $hits = $1 || ''; my $bytes = $2 || ''; my $duration = $3 || ''; if ($4 > $self->{"stat_netmax_$sum_type"}{$net}{largest_file_size}) { $self->{"stat_netmax_$sum_type"}{$net}{largest_file_size} = $4; $self->{"stat_netmax_$sum_type"}{$net}{largest_file_url} = $5; } $hits =~ s/,$//; $bytes =~ s/,$//; $duration =~ s/,$//; my %hits_tmp = split(/[:,]/, $hits); foreach my $tmp (sort {$a <=> $b} keys %hits_tmp) { if ($key ne '') { $k = $key; } else { $k = $tmp; } $self->{"stat_network_$sum_type"}{$net}{$k}{hits} += $hits_tmp{$tmp}; } my %bytes_tmp = split(/[:,]/, $bytes); foreach my $tmp (sort {$a <=> $b} keys %bytes_tmp) { if ($key ne '') { $k = $key; } else { $k = $tmp; } $self->{"stat_network_$sum_type"}{$net}{$k}{bytes} += $bytes_tmp{$tmp}; } my %duration_tmp = split(/[:,]/, $duration); foreach my $tmp (sort {$a <=> $b} keys %duration_tmp) { if ($key ne '') { $k = $key; } else { $k = $tmp; } $self->{"stat_network_$sum_type"}{$net}{$k}{duration} += $duration_tmp{$tmp}; } } else { print STDERR "ERROR: bad format at line $i into $self->{Output}/$path/stat_network.dat\n"; print STDERR "$l\n"; unlink($self->{pidfile}); exit 0; } $i++; } $dat_file_network->close(); } #### Read previous user per network statistics my $dat_file_netuser = new IO::File; if ($dat_file_netuser->open("$self->{Output}/$path/stat_netuser.dat")) { my $i = 1; while (my $l = <$dat_file_netuser>) { chomp($l); my ($net, $id, $data) = split(/\t/, $l); if (!$data) { # Assume backward compatibility $l =~ s/^(.*)\s([^\s]+)\shits=/hits=/; $net = $1; $id = $2; $data = $l; } if ($data =~ s/^hits=(\d+);bytes=(\d+);duration=(\d+);largest_file_size=([^;]*);largest_file_url=(.*)$//) { $self->{"stat_netuser_$sum_type"}{$net}{$id}{hits} += $1; $self->{"stat_netuser_$sum_type"}{$net}{$id}{bytes} += $2; $self->{"stat_netuser_$sum_type"}{$net}{$id}{duration} += $3; if ($6 > $self->{"stat_netuser_$sum_type"}{$net}{$id}{largest_file_size}) { $self->{"stat_netuser_$sum_type"}{$net}{$id}{largest_file_size} = $4; $self->{"stat_netuser_$sum_type"}{$net}{$id}{largest_file_url} = $5; } } else { print STDERR "ERROR: bad format at line $i into $self->{Output}/$path/stat_netuser.dat\n"; print STDERR "$l\n"; unlink($self->{pidfile}); exit 0; } $i++; } $dat_file_netuser->close(); } #### Read previous cache statistics my $dat_file_code = new IO::File; if ($dat_file_code->open("$self->{Output}/$path/stat_code.dat")) { my $i = 1; while (my $l = <$dat_file_code>) { chomp($l); if ($l =~ s/^([^\s]+)\s+hits_$type=([^;]+);bytes_$type=([^;]+)$//) { my $code = $1; my $hits = $2 || ''; my $bytes = $3 || ''; $hits =~ s/,$//; $bytes =~ s/,$//; my %hits_tmp = split(/[:,]/, $hits); foreach my $tmp (sort {$a <=> $b} keys %hits_tmp) { if ($key ne '') { $k = $key; } else { $k = $tmp; } $self->{"stat_code_$sum_type"}{$code}{$k}{hits} += $hits_tmp{$tmp}; } my %bytes_tmp = split(/[:,]/, $bytes); foreach my $tmp (sort {$a <=> $b} keys %bytes_tmp) { if ($key ne '') { $k = $key; } else { $k = $tmp; } $self->{"stat_code_$sum_type"}{$code}{$k}{bytes} += $bytes_tmp{$tmp}; } } else { print STDERR "ERROR: bad format at line $i into $self->{Output}/$path/stat_code.dat\n"; print STDERR "$l\n"; unlink($self->{pidfile}); exit 0; } $i++; } $dat_file_code->close(); } #### Read previous mime statistics my $dat_file_mime_type = new IO::File; if ($dat_file_mime_type->open("$self->{Output}/$path/stat_mime_type.dat")) { my $i = 1; while (my $l = <$dat_file_mime_type>) { chomp($l); if ($l =~ s/^([^\s]+)\s+hits=(\d+);bytes=(\d+)//) { my $mime = $1; $self->{"stat_mime_type_$sum_type"}{$mime}{hits} += $2; $self->{"stat_mime_type_$sum_type"}{$mime}{bytes} += $3; } else { print STDERR "ERROR: bad format at line $i into $self->{Output}/$path/stat_mime_type.dat\n"; print STDERR "$l\n"; unlink($self->{pidfile}); exit 0; } $i++; } $dat_file_mime_type->close(); } } sub _print_header { my ($self, $fileout, $menu, $calendar, $sortpos) = @_; my $now = $self->{start_date} || strftime("%a %b %e %H:%M:%S %Y", localtime); $sortpos ||= 2; my $sorttable = ''; $sorttable = "var myTH = document.getElementById('contenu').getElementsByTagName('th')[$sortpos]; sorttable.innerSortFunction.apply(myTH, []);" if ($sortpos != 100); print $$fileout qq{ SquidAnalyzer $VERSION Report
$menu
}; } sub _print_footer { my ($self, $fileout) = @_; print $$fileout qq{
}; } sub check_build_date { my ($self, $year, $month, $day) = @_; return 0 if (!$self->{build_date}); my ($y, $m, $d) = split(/\-/, $self->{build_date}); return 1 if ($year ne $y); if ($m) { return 1 if ($month && ($month ne $m)); if ($d) { return 1 if ($day && ($day ne $d)); } } return 0; } sub buildHTML { my ($self, $outdir) = @_; $outdir ||= $self->{Output}; print STDERR "Building HTML output into $outdir\n" if (!$self->{QuietMode}); # Load history data for incremental scan my $old_year = 0; my $old_month = 0; my $old_day = 0; my $p_month = 0; my $p_year = 0; if ($self->{history_time}) { my @ltime = localtime($self->{history_time}); $old_year = $ltime[5]+1900; $old_month = $ltime[4]+1; $old_month = "0$old_month" if ($old_month < 10); $old_day = $ltime[3]; $old_day = "0$old_day" if ($old_day < 10); # Set oldest stat to preserve based on history time, not current time if ($self->{preserve} > 0) { @ltime = localtime($self->{history_time}-($self->{preserve}*2592000)); $p_year = $ltime[5]+1900; $p_month = $ltime[4]+1; $p_month = sprintf("%02d", $p_month); print STDERR "Obsolete statistics before $p_year-$p_month\n" if (!$self->{QuietMode}); } } # Generate all HTML output opendir(DIR, $outdir) || die "Error: can't opendir $outdir: $!"; my @years = grep { /^\d{4}$/ && -d "$outdir/$_"} readdir(DIR); closedir DIR; foreach my $y (sort {$a <=> $b} @years) { next if (!$y); next if ($self->check_build_date($y)); # Remove the full year repository if it is older that the last date to preserve if ($p_year && ($y < $p_year)) { print STDERR "Removing obsolete statistics for year $y\n" if (!$self->{QuietMode}); system ($RM_PROG, "-rf", "$outdir/$y"); next; } next if (!$p_year && ($y < $old_year)); opendir(DIR, "$outdir/$y") || $self->localdie("Error: can't opendir $outdir/$y: $!"); my @months = grep { /^\d{2}$/ && -d "$outdir/$y/$_"} readdir(DIR); my @weeks = grep { /^week\d{2}$/ && -d "$outdir/$y/$_"} readdir(DIR); closedir DIR; my @weeks_to_build = (); foreach my $m (sort {$a <=> $b} @months) { next if (!$m); next if ($self->check_build_date($y, $m)); # Remove the full month repository if it is older that the last date to preserve if ($p_year && ("$y$m" < "$p_year$p_month")) { print STDERR "Removing obsolete statistics for month $y-$m\n" if (!$self->{QuietMode}); system ($RM_PROG, "-rf", "$outdir/$y/$m"); next; } next if ("$y$m" < "$old_year$old_month"); opendir(DIR, "$outdir/$y/$m") || $self->localdie("Error: can't opendir $outdir/$y/$m: $!"); my @days = grep { /^\d{2}$/ && -d "$outdir/$y/$m/$_"} readdir(DIR); closedir DIR; foreach my $d (sort {$a <=> $b} @days) { next if ($self->check_build_date($y, $m, $d)); next if ("$y$m$d" < "$old_year$old_month$old_day"); print STDERR "Generating daily statistics for day $y-$m-$d\n" if (!$self->{QuietMode}); $self->gen_html_output($outdir, $y, $m, $d); my $wn = &get_week_number($y,$m,$d); push(@weeks_to_build, $wn) if (!grep(/^$wn$/, @weeks_to_build)); } print STDERR "Generating monthly statistics for month $y-$m\n" if (!$self->{QuietMode}); $self->gen_html_output($outdir, $y, $m); } foreach my $w (sort @weeks_to_build) { $w = sprintf("%02d", $w+1); print STDERR "Generating weekly statistics for week $w on year $y\n" if (!$self->{QuietMode}); $self->gen_html_output($outdir, $y, '', '', $w); } print STDERR "Generating yearly statistics for year $y\n" if (!$self->{QuietMode}); $self->gen_html_output($outdir, $y); } if (!$self->{no_year_stat}) { $self->_gen_summary($outdir); } else { $self->_gen_year_summary($outdir); } } sub gen_html_output { my ($self, $outdir, $year, $month, $day, $week) = @_; my $dir = "$outdir"; if ($year) { $dir .= "/$year"; } if ($month) { $dir .= "/$month"; } if ($day) { $dir .= "/$day"; } my $stat_date = $self->set_date($year, $month, $day); if ($week) { $dir .= "/week$week"; $stat_date = "$Translate{Week} $week - $year"; } my $nuser = 0; my $nurl = 0; my $ndomain = 0; if ( !$self->{no_year_stat} || $month || $week) { print STDERR "\tUser statistics in $dir...\n" if (!$self->{QuietMode}); $nuser = $self->_print_user_stat($dir, $year, $month, $day, $week); print STDERR "\tMime type statistics in $dir...\n" if (!$self->{QuietMode}); $self->_print_mime_stat($dir, $year, $month, $day, $week); print STDERR "\tNetwork statistics in $dir...\n" if (!$self->{QuietMode}); $self->_print_network_stat($dir, $year, $month, $day, $week); if ($self->{UrlReport}) { print STDERR "\tTop URL statistics in $dir...\n" if (!$self->{QuietMode}); $nurl = $self->_print_top_url_stat($dir, $year, $month, $day, $week); print STDERR "\tTop domain statistics in $dir...\n" if (!$self->{QuietMode}); $ndomain = $self->_print_top_domain_stat($dir, $year, $month, $day, $week); } } print STDERR "\tCache statistics in $dir...\n" if (!$self->{QuietMode}); $self->_print_cache_stat($dir, $year, $month, $day, $nuser, $nurl, $ndomain, $week); return ($nuser, $nurl, $ndomain); } sub parse_duration { my ($secondes) = @_; my $hours = int($secondes/3600); $hours = "0$hours" if ($hours < 10); $secondes = $secondes - ($hours*3600); my $minutes = int($secondes/60); $minutes = "0$minutes" if ($minutes < 10); $secondes = $secondes - ($minutes*60); $secondes = "0$secondes" if ($secondes < 10); return "$hours:$minutes:$secondes"; } sub _print_cache_stat { my ($self, $outdir, $year, $month, $day, $nuser, $nurl, $ndomain, $week) = @_; my $stat_date = $self->set_date($year, $month, $day); my $type = 'hour'; if (!$day) { $type = 'day'; } if (!$month) { $type = 'month'; } if ($week) { $type = 'day'; } # Load code statistics my %code_stat = (); my %detail_code_stat = (); my $infile = new IO::File; if ($infile->open("$outdir/stat_code.dat")) { while (my $l = <$infile>) { chomp($l); my ($code, $data) = split(/\s/, $l); $data =~ /hits_$type=([^;]+);bytes_$type=([^;]+)/; my $hits = $1 || ''; my $bytes = $2 || ''; $hits =~ s/,$//; $bytes =~ s/,$//; my %hits_tmp = split(/[:,]/, $hits); foreach my $tmp (sort {$a <=> $b} keys %hits_tmp) { $detail_code_stat{$code}{$tmp}{request} = $hits_tmp{$tmp}; $code_stat{$code}{request} += $hits_tmp{$tmp}; } my %bytes_tmp = split(/[:,]/, $bytes); foreach my $tmp (sort {$a <=> $b} keys %bytes_tmp) { $detail_code_stat{$code}{$tmp}{bytes} = $bytes_tmp{$tmp}; $code_stat{$code}{bytes} += $bytes_tmp{$tmp}; } } $infile->close(); } my $total_request = $code_stat{HIT}{request} + $code_stat{MISS}{request}; my $total_bytes = $code_stat{HIT}{bytes} + $code_stat{MISS}{bytes}; my $total_denied = $code_stat{DENIED}{request} + $code_stat{DENIED}{request}; if ($week && !-d "$outdir") { return; } my $file = $outdir . '/index.html'; my $out = new IO::File; $out->open(">$file") || $self->localdie("ERROR: Unable to open $file. $!\n"); # Print the HTML header my $cal = $self->_get_calendar($stat_date, $type, $outdir); $cal = '' if ($week); if ( !$self->{no_year_stat} || ($type ne 'month') ) { $self->_print_header(\$out, $self->{menu}, $cal); print $out $self->_print_title($Translate{'Cache_title'}, $stat_date, $week); } else { $self->_print_header(\$out, $self->{menu3}, $cal); print $out $self->_print_title($Translate{'Cache_title'}, $stat_date, $week); %code_stat = (); $self->_print_footer(\$out); $out->close(); return; } my $total_cost = sprintf("%2.2f", int($total_bytes/1000000) * $self->{CostPrice}); my $comma_bytes = $self->format_bytes($total_bytes); my $hit_bytes = $self->format_bytes($code_stat{HIT}{bytes}); my $miss_bytes = $self->format_bytes($code_stat{MISS}{bytes}); my $denied_bytes = $self->format_bytes($code_stat{DENIED}{bytes}); my $colspn = 5; $colspn = 6 if ($self->{CostPrice}); my $title = $Translate{'Hourly'} || 'Hourly'; my $unit = $Translate{'Hours'} || 'Hours'; my @xaxis = (); my @xstick = (); if ($type eq 'day') { if (!$week) { $title = $Translate{'Daily'} || 'Daily'; for ("01" .. "31") { push(@xaxis, "$_"); } } else { @xaxis = &get_wdays_per_year($week - 1, $year); foreach my $x (@xaxis) { push(@xstick, POSIX::strftime("%F", localtime($x/1000))); } map { s/\d{4}-\d{2}-//; } @xstick; $title = $Translate{'Weekly'} || 'Weekly'; $type = 'week'; $type = '[' . join(',', @xaxis) . ']'; } $unit = $Translate{'Days'} || 'Days'; } elsif ($type eq 'month') { $title = $Translate{'Monthly'} || 'Monthly'; $unit = $Translate{'Months'} || 'Months'; for ("01" .. "12") { push(@xaxis, "$_"); } } else { for ("00" .. "23") { push(@xaxis, "$_"); } } my @hit = (); my @miss = (); my @denied = (); my @total = (); for (my $i = 0; $i <= $#xaxis; $i++) { my $ddate = $xaxis[$i]; $ddate = $xstick[$i] if ($#xstick >= 0); my $tot = 0; if (exists $detail_code_stat{HIT}{$ddate}{request}) { push(@hit, "[ $xaxis[$i], $detail_code_stat{HIT}{$ddate}{request} ]"); $tot += $detail_code_stat{HIT}{$ddate}{request}; } else { push(@hit, "[ $xaxis[$i], 0 ]"); } if (exists $detail_code_stat{MISS}{$ddate}{request}) { push(@miss, "[ $xaxis[$i], $detail_code_stat{MISS}{$ddate}{request} ]"); $tot += $detail_code_stat{MISS}{$ddate}{request}; } else { push(@miss, "[ $xaxis[$i], 0 ]"); } if (exists $detail_code_stat{DENIED}{$ddate}{request}) { push(@denied, "[ $xaxis[$i], $detail_code_stat{DENIED}{$ddate}{request} ]"); } else { push(@denied, "[ $xaxis[$i], 0 ]"); } push(@total, "[ $xaxis[$i], $tot ]"); delete $detail_code_stat{HIT}{$ddate}{request}; delete $detail_code_stat{MISS}{$ddate}{request}; delete $detail_code_stat{DENIED}{$ddate}{request}; } my $t1 = $Translate{'Graph_cache_hit_title'}; $t1 =~ s/\%s/$title/; $t1 = "$t1 $stat_date"; my $xlabel = $unit || ''; my $ylabel = $Translate{'Requests_graph'} || 'Requests'; my $code_requests = $self->flotr2_bargraph(1, 'code_requests', $type, $t1, $xlabel, $ylabel, join(',', @total), $Translate{'Total_graph'} . " ($Translate{'Hit_graph'}+$Translate{'Miss_graph'})", join(',', @hit), $Translate{'Hit_graph'}, join(',', @miss), $Translate{'Miss_graph'}, join(',', @denied), $Translate{'Denied_graph'} ); @hit = (); @miss = (); @denied = (); @total = (); for (my $i = 0; $i <= $#xaxis; $i++) { my $ddate = $xaxis[$i]; $ddate = $xstick[$i] if ($#xstick >= 0); my $tot = 0; if (exists $detail_code_stat{HIT}{$ddate}{bytes}) { push(@hit, "[ $xaxis[$i], " . int($detail_code_stat{HIT}{$ddate}{bytes}/1000000) . " ]"); $tot += $detail_code_stat{HIT}{$ddate}{bytes}; } else { push(@hit, "[ $xaxis[$i], 0 ]"); } if (exists $detail_code_stat{MISS}{$ddate}{bytes}) { push(@miss, "[ $xaxis[$i], " . int($detail_code_stat{MISS}{$ddate}{bytes}/1000000) . " ]"); $tot += $detail_code_stat{MISS}{$ddate}{bytes}; } else { push(@miss, "[ $xaxis[$i], 0 ]"); } if (exists $detail_code_stat{DENIED}{$ddate}{bytes}) { push(@denied, "[ $xaxis[$i], " . int($detail_code_stat{DENIED}{$ddate}{bytes}/1000000) . " ]"); } else { push(@denied, "[ $xaxis[$i], 0 ]"); } push(@total, "[ $xaxis[$i], " . int($tot/1000000) . " ]"); } %detail_code_stat = (); $t1 = $Translate{'Graph_cache_byte_title'}; $t1 =~ s/\%s/$title/; $t1 = "$t1 $stat_date"; $ylabel = $Translate{'Megabytes_graph'} || $Translate{'Megabytes'}; my $code_bytes = $self->flotr2_bargraph(2, 'code_bytes', $type, $t1, $xlabel, $ylabel, join(',', @total), $Translate{'Total_graph'} . " ($Translate{'Hit_graph'}+$Translate{'Miss_graph'})", join(',', @hit), $Translate{'Hit_graph'}, join(',', @miss), $Translate{'Miss_graph'}, join(',', @denied), $Translate{'Denied_graph'}); @hit = (); @miss = (); @denied = (); @total = (); print $out qq{ }; print $out qq{ } if ($self->{CostPrice}); print $out qq{ }; print $out qq{ } if ($self->{CostPrice}); print $out qq{
$Translate{'Requests'} $Translate{$self->{TransfertUnit}} $Translate{'Total'}
$Translate{'Hit'} $Translate{'Miss'} $Translate{'Denied'} $Translate{'Hit'} $Translate{'Miss'} $Translate{'Denied'} $Translate{'Requests'} $Translate{$self->{TransfertUnit}} $Translate{'Users'} $Translate{'Sites'} $Translate{'Domains'}$Translate{'Cost'} $self->{Currency}
$code_stat{HIT}{request} $code_stat{MISS}{request} $code_stat{DENIED}{request} $hit_bytes $miss_bytes $denied_bytes $total_request $comma_bytes $nuser $nurl $ndomain$total_cost
$code_requests$code_bytes

$Translate{'Legend'}

$Translate{'Hit'}: $Translate{'Hit_help'}
$Translate{'Miss'}: $Translate{'Miss_help'}
$Translate{'Denied'}: $Translate{'Denied_help'}
$Translate{'Users'}: $Translate{'Users_help'}
$Translate{'Sites'}: $Translate{'Sites_help'}
$Translate{'Domains'}: $Translate{'Domains_help'}
}; print $out qq{ $Translate{'Cost'}: $Translate{'Cost_help'} $self->{CostPrice} $self->{Currency}
} if ($self->{CostPrice}); print $out qq{
}; %code_stat = (); $self->_print_footer(\$out); $out->close(); } sub _print_mime_stat { my ($self, $outdir, $year, $month, $day, $week) = @_; my $stat_date = $self->set_date($year, $month, $day); my $type = 'hour'; if (!$day) { $type = 'day'; } if (!$month) { $type = 'month'; } if ($week) { $type = 'day'; } # Load code statistics my $infile = new IO::File; $infile->open("$outdir/stat_mime_type.dat") || return; my %mime_stat = (); my $total_count = 0; my $total_bytes = 0; while(my $l = <$infile>) { chomp($l); my ($code, $data) = split(/\s/, $l); $data =~ /hits=(\d+);bytes=(\d+)/; $mime_stat{$code}{hits} = $1; $mime_stat{$code}{bytes} = $2; $total_count += $1; $total_bytes += $2; } $infile->close(); my $ntype = scalar keys %mime_stat; my $file = $outdir . '/mime_type.html'; my $out = new IO::File; $out->open(">$file") || $self->localdie("ERROR: Unable to open $file. $!\n"); my $sortpos = 1; $sortpos = 2 if ($self->{OrderMime} eq 'bytes'); $sortpos = 3 if ($self->{OrderMime} eq 'duration'); # Print the HTML header my $cal = $self->_get_calendar($stat_date, $type, $outdir); $cal = '' if ($week); $self->_print_header(\$out, $self->{menu}, $cal, $sortpos); # Print title and calendar view print $out $self->_print_title($Translate{'Mime_title'}, $stat_date, $week); my %data = (); $total_count ||= 1; foreach my $mime (keys %mime_stat) { if (($mime_stat{$mime}{hits}/$total_count)*100 > $self->{MinPie}) { $data{$mime} = $mime_stat{$mime}{hits}; } else { $data{'others'} += $mime_stat{$mime}{hits}; } } my $title = "$Translate{'Mime_graph_hits_title'} $stat_date"; my $mime_hits = $self->flotr2_piegraph(1, 'mime_hits', $title, $Translate{'Mime_graph'}, '', %data); print $out qq{}; $mime_hits = ''; %data = (); $total_bytes ||= 1; foreach my $mime (keys %mime_stat) { if (($mime_stat{$mime}{bytes}/$total_bytes)*100 > $self->{MinPie}) { $data{$mime} = int($mime_stat{$mime}{bytes}/1000000); } else { $data{'others'} += $mime_stat{$mime}{bytes}; } } $data{'others'} = int($data{'others'}/1000000); $title = "$Translate{'Mime_graph_bytes_title'} $stat_date"; my $mime_bytes = $self->flotr2_piegraph(1, 'mime_bytes', $title, $Translate{'Mime_graph'}, '', %data); print $out qq{
$mime_hits$mime_bytes
}; $mime_bytes = ''; %data = (); print $out "

$Translate{'Mime_number'}: $ntype

\n"; print $out qq{ }; print $out qq{ } if ($self->{CostPrice}); print $out qq{ }; foreach (sort { $mime_stat{$b}{"$self->{OrderMime}"} <=> $mime_stat{$a}{"$self->{OrderMime}"} } keys %mime_stat) { my $c_percent = '0.0'; $c_percent = sprintf("%2.2f", ($mime_stat{$_}{hits}/$total_count) * 100) if ($total_count); my $b_percent = '0.0'; $b_percent = sprintf("%2.2f", ($mime_stat{$_}{bytes}/$total_bytes) * 100) if ($total_bytes); my $total_cost = sprintf("%2.2f", int($mime_stat{$_}{bytes}/1000000) * $self->{CostPrice}); my $comma_bytes = $self->format_bytes($mime_stat{$_}{bytes}); print $out qq{ }; print $out qq{ } if ($self->{CostPrice}); print $out qq{ }; } $sortpos = 1; $sortpos = 2 if ($self->{OrderMime} eq 'bytes'); print $out qq{
$Translate{'Mime_link'} $Translate{'Requests'} (%) $Translate{$self->{TransfertUnit}} (%)$Translate{'Cost'} $self->{Currency}
$_ $mime_stat{$_}{hits} ($c_percent) $comma_bytes ($b_percent)$total_cost
}; print $out qq{ }; $self->_print_footer(\$out); $out->close(); } sub _print_network_stat { my ($self, $outdir, $year, $month, $day, $week) = @_; my $stat_date = $self->set_date($year, $month, $day); my $type = 'hour'; if (!$day) { $type = 'day'; } if (!$month) { $type = 'month'; } if ($week) { $type = 'day'; } # Load code statistics my $infile = new IO::File; $infile->open("$outdir/stat_network.dat") || return; my %network_stat = (); my %detail_network_stat = (); my %total_net_detail = (); my $total_hit = 0; my $total_bytes = 0; my $total_duration = 0; while (my $l = <$infile>) { chomp($l); my ($network, $data) = split(/\t/, $l); if (!$data) { # Assume backward compatibility $l =~ s/^(.*)\shits_$type=/hits_$type=/; $network = $1; $data = $l; } $data =~ /^hits_$type=([^;]+);bytes_$type=([^;]+);duration_$type=([^;]+);largest_file_size=([^;]*);largest_file_url=(.*)/; my $hits = $1 || ''; my $bytes = $2 || ''; my $duration = $3 || ''; $network_stat{$network}{largest_file} = $4; $network_stat{$network}{url} = $5; $hits =~ s/,$//; $bytes =~ s/,$//; $duration =~ s/,$//; my %hits_tmp = split(/[:,]/, $hits); foreach my $tmp (sort {$a <=> $b} keys %hits_tmp) { $detail_network_stat{$network}{$tmp}{hits} = $hits_tmp{$tmp}; $total_net_detail{$tmp}{hits} += $hits_tmp{$tmp}; $network_stat{$network}{hits} += $hits_tmp{$tmp}; $total_hit += $hits_tmp{$tmp}; } my %bytes_tmp = split(/[:,]/, $bytes); foreach my $tmp (sort {$a <=> $b} keys %bytes_tmp) { $detail_network_stat{$network}{$tmp}{bytes} = $bytes_tmp{$tmp}; $total_net_detail{$tmp}{bytes} += $bytes_tmp{$tmp}; $network_stat{$network}{bytes} += $bytes_tmp{$tmp}; $total_bytes += $bytes_tmp{$tmp}; } my %duration_tmp = split(/[:,]/, $duration); foreach my $tmp (sort {$a <=> $b} keys %duration_tmp) { $detail_network_stat{$network}{$tmp}{duration} = $duration_tmp{$tmp}; $total_net_detail{$tmp}{duration} += $duration_tmp{$tmp}; $network_stat{$network}{duration} += $duration_tmp{$tmp}; $total_duration += $duration_tmp{$tmp}; } } $infile->close(); my $nnet = scalar keys %network_stat; my $sortpos = 1; $sortpos = 2 if ($self->{OrderNetwork} eq 'bytes'); $sortpos = 3 if ($self->{OrderNetwork} eq 'duration'); my $file = $outdir . '/network.html'; my $out = new IO::File; $out->open(">$file") || $self->localdie("ERROR: Unable to open $file. $!\n"); # Print the HTML header my $cal = $self->_get_calendar($stat_date, $type, $outdir); $cal = '' if ($week); $self->_print_header(\$out, $self->{menu}, $cal, $sortpos); print $out $self->_print_title($Translate{'Network_title'}, $stat_date, $week); my $last = '23'; my $first = '00'; my $title = $Translate{'Hourly'} || 'Hourly'; my $unit = $Translate{'Hours'} || 'Hours'; if ($type eq 'day') { $last = '31'; $first = '01'; $title = $Translate{'Daily'} || 'Daily'; $unit = $Translate{'Days'} || 'Days'; } elsif ($type eq 'month') { $last = '12'; $first = '01'; $title = $Translate{'Monthly'} || 'Monthly'; $unit = $Translate{'Months'} || 'Months'; } # # my @hits = (); # my @bytes = (); # for ("$first" .. "$last") { # if (exists $total_net_detail{$_}{hits}) { # push(@hits, "[ $_, $total_net_detail{$_}{hits} ]"); # } else { # push(@hits, "[ $_, 0 ]"); # } # if (exists $total_net_detail{$_}{bytes}) { # push(@bytes, "[ $_, " . int($total_net_detail{$_}{bytes}/1000000) . " ]"); # } else { # push(@bytes, "[ $_, 0 ]"); # } # } # %total_net_detail = (); # # my $t1 = $Translate{'Graph_cache_hit_title'}; # $t1 =~ s/\%s/$title/; # $t1 = "$t1 $stat_date"; # my $xlabel = $unit || ''; # my $ylabel = $Translate{'Requests_graph'} || 'Requests'; # my $network_hits = $self->flotr2_bargraph(1, 'network_hits', $type, $t1, $xlabel, $ylabel, # join(',', @hits), $Translate{'Hit_graph'} ); # @hits = (); # print $out qq{}; # $network_hits = ''; # # # $t1 = $Translate{'Graph_cache_byte_title'}; # $t1 =~ s/\%s/$title/; # $t1 = "$t1 $stat_date"; # $xlabel = $unit || ''; # $ylabel = $Translate{'Megabytes_graph'} || $Translate{'Megabytes'}; # my $network_bytes = $self->flotr2_bargraph(1, 'network_bytes', $type, $t1, $xlabel, $ylabel, # join(',', @bytes), $Translate{'Bytes'} ); # @bytes = (); # # print $out qq{
$network_hits$network_bytes
}; # $network_bytes = ''; print $out "

$Translate{'Network_number'}: $nnet

\n"; print $out qq{ }; print $out qq{ } if ($self->{CostPrice}); print $out qq{ }; if (!-d "$outdir/networks") { mkdir("$outdir/networks", 0755) || return; } foreach my $net (sort { $network_stat{$b}{"$self->{OrderNetwork}"} <=> $network_stat{$a}{"$self->{OrderNetwork}"} } keys %network_stat) { my $h_percent = '0.0'; $h_percent = sprintf("%2.2f", ($network_stat{$net}{hits}/$total_hit) * 100) if ($total_hit); my $b_percent = '0.0'; $b_percent = sprintf("%2.2f", ($network_stat{$net}{bytes}/$total_bytes) * 100) if ($total_bytes); my $d_percent = '0.0'; $d_percent = sprintf("%2.2f", ($network_stat{$net}{duration}/$total_duration) * 100) if ($total_duration); $network_stat{$net}{duration} = &parse_duration(int($network_stat{$net}{duration}/1000)); my $total_cost = sprintf("%2.2f", int($network_stat{$net}{bytes}/1000000) * $self->{CostPrice}); my $show = $net; if ($net =~ /^(\d+\.\d+\.\d+)/) { $show = "$1.0"; foreach my $r (keys %{$self->{NetworkAlias}}) { if ($r =~ /^\d+\.\d+\.\d+\.\d+\/\d+$/) { if (&check_ip($net, $r)) { $show = $self->{NetworkAlias}->{$r}; last; } } elsif ($show =~ /$r/) { $show = $self->{NetworkAlias}->{$r}; last; } } } my $comma_bytes = $self->format_bytes($network_stat{$net}{bytes}); print $out qq{ }; print $out qq{ } if ($self->{CostPrice}); if (!-d "$outdir/networks/$net") { mkdir("$outdir/networks/$net", 0755) || return; } my $outnet = new IO::File; $outnet->open(">$outdir/networks/$net/$net.html") || return; # Print the HTML header my $cal = $self->_get_calendar($stat_date, $type, $outdir, '../../'); $self->_print_header(\$outnet, $self->{menu2}, $cal, $sortpos); print $outnet $self->_print_title("$Translate{'Network_title'} $show -", $stat_date, $week); my @hits = (); my @bytes = (); for ("$first" .. "$last") { if (exists $detail_network_stat{$net}{$_}{hits}) { push(@hits, "[ $_, " . $detail_network_stat{$net}{$_}{hits} . " ]"); } else { push(@hits, "[ $_, 0 ]"); } if (exists $detail_network_stat{$net}{$_}{bytes}) { push(@bytes, "[ $_, " . int($detail_network_stat{$net}{$_}{bytes}/1000000) . " ]"); } else { push(@bytes, "[ $_, 0 ]"); } } delete $detail_network_stat{$net}; my $t1 = $Translate{'Graph_cache_hit_title'}; $t1 =~ s/\%s/$title $show/; $t1 = "$t1 $stat_date"; my $xlabel = $unit || ''; my $ylabel = $Translate{'Requests_graph'} || 'Requests'; my $network_hits = $self->flotr2_bargraph(1, 'network_hits', $type, $t1, $xlabel, $ylabel, join(',', @hits), $Translate{'Hit_graph'} ); @hits = (); print $outnet qq{
$Translate{'Network_link'} $Translate{'Requests'} (%) $Translate{$self->{TransfertUnit}} (%) $Translate{'Duration'} (%)$Translate{'Cost'} $self->{Currency}$Translate{'Users'} $Translate{'Largest'} $Translate{'Url'}
$show $network_stat{$net}{hits} ($h_percent) $comma_bytes ($b_percent) $network_stat{$net}{duration} ($d_percent)$total_cost
}; $network_hits = ''; $t1 = $Translate{'Graph_cache_byte_title'}; $t1 =~ s/\%s/$title/; $t1 = "$t1 $stat_date"; $xlabel = $unit || ''; $ylabel = $Translate{'Megabytes_graph'} || $Translate{'Megabytes'}; my $network_bytes = $self->flotr2_bargraph(1, 'network_bytes', $type, $t1, $xlabel, $ylabel, join(',', @bytes), $Translate{'Bytes'} ); @bytes = (); print $outnet qq{
$network_hits$network_bytes
}; $network_bytes = ''; my $retuser = $self->_print_netuser_stat($outdir, \$outnet, $net); my $comma_largest = $self->format_bytes($network_stat{$net}{largest_file}); print $out qq{ $retuser $comma_largest $network_stat{$net}{url} }; $sortpos = 1; $sortpos = 2 if ($self->{OrderNetwork} eq 'bytes'); $sortpos = 3 if ($self->{OrderNetwork} eq 'duration'); print $outnet qq{ }; $self->_print_footer(\$outnet); $outnet->close(); } print $out "\n"; $sortpos = 1; $sortpos = 2 if ($self->{OrderNetwork} eq 'bytes'); $sortpos = 3 if ($self->{OrderNetwork} eq 'duration'); print $out qq{ }; $self->_print_footer(\$out); $out->close(); } sub _print_user_stat { my ($self, $outdir, $year, $month, $day, $week) = @_; my $stat_date = $self->set_date($year, $month, $day); my $type = 'hour'; if (!$day) { $type = 'day'; } if (!$month) { $type = 'month'; } if ($week) { $type = 'day'; } # Load code statistics my $infile = new IO::File; $infile->open("$outdir/stat_user.dat") || return; my %user_stat = (); my %detail_user_stat = (); my %total_user_detail = (); my $total_hit = 0; my $total_bytes = 0; my $total_duration = 0; while(my $l = <$infile>) { chomp($l); my ($user, $data) = split(/\s/, $l); $data =~ /hits_$type=([^;]+);bytes_$type=([^;]+);duration_$type=([^;]+);largest_file_size=([^;]*);largest_file_url=(.*)/; my $hits = $1 || ''; my $bytes = $2 || ''; my $duration = $3 || ''; $user_stat{$user}{largest_file} = $4; $user_stat{$user}{url} = $5; $hits =~ s/,$//; $bytes =~ s/,$//; $duration =~ s/,$//; my %hits_tmp = split(/[:,]/, $hits); foreach my $tmp (sort {$a <=> $b} keys %hits_tmp) { $detail_user_stat{$user}{$tmp}{hits} = $hits_tmp{$tmp}; $total_user_detail{$tmp}{hits} += $hits_tmp{$tmp}; $user_stat{$user}{hits} += $hits_tmp{$tmp}; $total_hit += $hits_tmp{$tmp}; } my %bytes_tmp = split(/[:,]/, $bytes); foreach my $tmp (sort {$a <=> $b} keys %bytes_tmp) { $detail_user_stat{$user}{$tmp}{bytes} = $bytes_tmp{$tmp}; $total_user_detail{$tmp}{bytes} += $bytes_tmp{$tmp}; $user_stat{$user}{bytes} += $bytes_tmp{$tmp}; $total_bytes += $bytes_tmp{$tmp}; } my %duration_tmp = split(/[:,]/, $duration); foreach my $tmp (sort {$a <=> $b} keys %duration_tmp) { $detail_user_stat{$user}{$tmp}{duration} = $duration_tmp{$tmp}; $total_user_detail{$tmp}{duration} += $duration_tmp{$tmp}; $user_stat{$user}{duration} += $duration_tmp{$tmp}; $total_duration += $duration_tmp{$tmp}; } } $infile->close(); my $nuser = scalar keys %user_stat; my $file = $outdir . '/user.html'; my $out = new IO::File; $out->open(">$file") || $self->localdie("ERROR: Unable to open $file. $!\n"); my $sortpos = 1; $sortpos = 2 if ($self->{OrderUser} eq 'bytes'); $sortpos = 3 if ($self->{OrderUser} eq 'duration'); # Print the HTML header my $cal = $self->_get_calendar($stat_date, $type, $outdir); $cal = '' if ($week); $self->_print_header(\$out, $self->{menu}, $cal, $sortpos); my $last = '23'; my $first = '00'; my $title = $Translate{'Hourly'} || 'Hourly'; my $unit = $Translate{'Hours'} || 'Hours'; if ($type eq 'day') { $last = '31'; $first = '01'; $title = $Translate{'Daily'} || 'Daily'; $unit = $Translate{'Days'} || 'Days'; } elsif ($type eq 'month') { $last = '12'; $first = '01'; $title = $Translate{'Monthly'} || 'Monthly'; $unit = $Translate{'Months'} || 'Months'; } %total_user_detail = (); print $out $self->_print_title($Translate{'User_title'}, $stat_date, $week); print $out "

$Translate{'User_number'}: $nuser

\n"; print $out qq{ }; print $out qq{ } if ($self->{CostPrice}); print $out qq{ }; if (!-d "$outdir/users") { mkdir("$outdir/users", 0755) || return; } foreach my $usr (sort { $user_stat{$b}{"$self->{OrderUser}"} <=> $user_stat{$a}{"$self->{OrderUser}"} } keys %user_stat) { my $h_percent = '0.0'; $h_percent = sprintf("%2.2f", ($user_stat{$usr}{hits}/$total_hit) * 100) if ($total_hit); my $b_percent = '0.0'; $b_percent = sprintf("%2.2f", ($user_stat{$usr}{bytes}/$total_bytes) * 100) if ($total_bytes); my $d_percent = '0.0'; $d_percent = sprintf("%2.2f", ($user_stat{$usr}{duration}/$total_duration) * 100) if ($total_duration); $user_stat{$usr}{duration} = &parse_duration(int($user_stat{$usr}{duration}/1000)); my $total_cost = sprintf("%2.2f", int($user_stat{$usr}{bytes}/1000000) * $self->{CostPrice}); my $show = $usr; foreach my $u (keys %{$self->{UserAlias}}) { if ( $usr =~ /^$u$/i ) { $show = $self->{UserAlias}->{$u}; last; } } $show =~ s/_SPC_/ /g; my $url = &escape($usr); my $comma_bytes = $self->format_bytes($user_stat{$usr}{bytes}); if ($self->{UrlReport}) { print $out qq{ }; } else { print $out qq{ }; } print $out qq{ }; print $out qq{ } if ($self->{CostPrice}); my $comma_largest = $self->format_bytes($user_stat{$usr}{largest_file}); print $out qq{ }; if (!-d "$outdir/users/$url") { mkdir("$outdir/users/$url", 0755) || return; } my $outusr = new IO::File; $outusr->open(">$outdir/users/$url/$url.html") || return; # Print the HTML header my $cal = $self->_get_calendar($stat_date, $type, $outdir, '../../'); $self->_print_header(\$outusr, $self->{menu2}, $cal, $sortpos); print $outusr $self->_print_title("$Translate{'User_title'} $usr -", $stat_date, $week); my @hits = (); my @bytes = (); for ("$first" .. "$last") { if (exists $detail_user_stat{$usr}{$_}{hits}) { push(@hits, "[ $_, $detail_user_stat{$usr}{$_}{hits} ]"); } else { push(@hits, "[ $_, 0 ]"); } if (exists $detail_user_stat{$usr}{$_}{bytes}) { push(@bytes, "[ $_, " . int($detail_user_stat{$usr}{$_}{bytes}/1000000) . " ]"); } else { push(@bytes, "[ $_, 0 ]"); } } delete $detail_user_stat{$usr}; my $t1 = $Translate{'Graph_cache_hit_title'}; $t1 =~ s/\%s/$title $show/; $t1 = "$t1 $stat_date"; my $xlabel = $unit || ''; my $ylabel = $Translate{'Requests_graph'} || 'Requests'; my $user_hits = $self->flotr2_bargraph(1, 'user_hits', $type, $t1, $xlabel, $ylabel, join(',', @hits), $Translate{'Hit_graph'}); @hits = (); print $outusr qq{
$Translate{'Users'} $Translate{'Requests'} (%) $Translate{$self->{TransfertUnit}} (%) $Translate{'Duration'} (%)$Translate{'Cost'} $self->{Currency}$Translate{'Largest'} $Translate{'Url'}
$show
$show$user_stat{$usr}{hits} ($h_percent) $comma_bytes ($b_percent) $user_stat{$usr}{duration} ($d_percent)$total_cost$comma_largest $user_stat{$usr}{url}
}; $user_hits = ''; $t1 = $Translate{'Graph_cache_byte_title'}; $t1 =~ s/\%s/$title $show/; $t1 = "$t1 $stat_date"; $xlabel = $unit || ''; $ylabel = $Translate{'Megabytes_graph'} || $Translate{'Megabytes'}; my $user_bytes = $self->flotr2_bargraph(1, 'user_bytes', $type, $t1, $xlabel, $ylabel, join(',', @bytes), $Translate{'Bytes'}); @bytes = (); print $outusr qq{
$user_hits$user_bytes
}; $user_bytes = ''; delete $user_stat{$usr}; if ($self->{UrlReport}) { $self->_print_user_detail(\$outusr, $outdir, $usr, $type); } $self->_print_footer(\$outusr); $outusr->close(); } $sortpos = 1; $sortpos = 2 if ($self->{OrderUser} eq 'bytes'); $sortpos = 3 if ($self->{OrderUser} eq 'duration'); print $out qq{ }; print $out qq{ }; $self->_print_footer(\$out); $out->close(); return $nuser; } sub _print_netuser_stat { my ($self, $outdir, $out, $usrnet) = @_; # Load code statistics my $infile = new IO::File; $infile->open("$outdir/stat_netuser.dat") || return; my %netuser_stat = (); my $total_hit = 0; my $total_bytes = 0; my $total_duration = 0; while(my $l = <$infile>) { chomp($l); my ($network, $user, $data) = split(/\t/, $l); if (!$data) { # Assume backward compatibility $l =~ s/^(.*)\s([^\s]+)\shits=/hits=/; $network = $1; $user = $2; $data = $l; } next if ($network ne $usrnet); $data =~ /^hits=(\d+);bytes=(\d+);duration=(\d+);largest_file_size=([^;]*);largest_file_url=(.*)/; $netuser_stat{$user}{hits} = $1; $netuser_stat{$user}{bytes} = $2; $netuser_stat{$user}{duration} = $3; $netuser_stat{$user}{largest_file} = $4; $total_hit += $1; $total_bytes += $2; $total_duration += $3; $netuser_stat{$user}{url} = $5; } $infile->close(); my $nuser = scalar keys %netuser_stat; print $$out qq{

$Translate{'User_number'}: $nuser

}; print $$out qq{ }; print $$out qq{ } if ($self->{CostPrice}); print $$out qq{ }; foreach my $usr (sort { $netuser_stat{$b}{"$self->{OrderUser}"} <=> $netuser_stat{$a}{"$self->{OrderUser}"} } keys %netuser_stat) { my $h_percent = '0.0'; $h_percent = sprintf("%2.2f", ($netuser_stat{$usr}{hits}/$total_hit) * 100) if ($total_hit); my $b_percent = '0.0'; $b_percent = sprintf("%2.2f", ($netuser_stat{$usr}{bytes}/$total_bytes) * 100) if ($total_bytes); my $d_percent = '0.0'; $d_percent = sprintf("%2.2f", ($netuser_stat{$usr}{duration}/$total_duration) * 100) if ($total_duration); $netuser_stat{$usr}{duration} = &parse_duration(int($netuser_stat{$usr}{duration}/1000)); my $total_cost = sprintf("%2.2f", int($netuser_stat{$usr}{bytes}/1000000) * $self->{CostPrice}); my $show = $usr; foreach my $u (keys %{$self->{UserAlias}}) { if ( $usr =~ /^$u$/i ) { $show = $self->{UserAlias}->{$u}; last; } } $show =~ s/_SPC_/ /g; my $url = &escape($usr); my $comma_bytes = $self->format_bytes($netuser_stat{$usr}{bytes}); if ($self->{UrlReport}) { print $$out qq{ }; } else { print $$out qq{ }; } print $$out qq{ }; print $$out qq{ } if ($self->{CostPrice}); my $comma_largest = $self->format_bytes($netuser_stat{$usr}{largest_file}); print $$out qq{ }; } print $$out qq{
$Translate{'Users'} $Translate{'Requests'} (%) $Translate{$self->{TransfertUnit}} (%) $Translate{'Duration'} (%)$Translate{'Cost'} $self->{Currency}$Translate{'Largest'} $Translate{'Url'}
$show
$show$netuser_stat{$usr}{hits} ($h_percent) $comma_bytes ($b_percent) $netuser_stat{$usr}{duration} ($d_percent)$total_cost$comma_largest $netuser_stat{$usr}{url}
}; return $nuser; } sub _print_user_detail { my ($self, $out, $outdir, $usr, $type) = @_; # Load code statistics my $infile = new IO::File; $infile->open("$outdir/stat_user_url.dat") || return; my %url_stat = (); my $total_hit = 0; my $total_bytes = 0; my $total_duration = 0; my $total_cache_hit = 0; my $total_cache_bytes = 0; my $ok = 0; while(my $l = <$infile>) { chomp($l); my ($user, $data) = split(/\s/, $l); last if (($user ne $usr) && $ok); next if ($user ne $usr); $ok = 1; if ($data =~ /hits=(\d+);bytes=(\d+);duration=(\d+);first=([^;]*);last=([^;]*);url=(.*?);cache_hit=(\d*);cache_bytes=(\d*)/) { $url_stat{$6}{hits} = $1; $url_stat{$6}{bytes} = $2; $url_stat{$6}{duration} = $3; $url_stat{$6}{firsthit} = $4 if (!$url_stat{$6}{firsthit} || ($4 < $url_stat{$6}{firsthit})); $url_stat{$6}{lasthit} = $5 if (!$url_stat{$6}{lasthit} || ($5 > $url_stat{$6}{lasthit})); $url_stat{$6}{cache_hit} = $7; $url_stat{$6}{cache_bytes} = $8; $total_hit += $1; $total_bytes += $2; $total_duration += $3; $total_cache_hit += $7; $total_cache_bytes += $8; } elsif ($data =~ /hits=(\d+);bytes=(\d+);duration=(\d+);first=([^;]*);last=([^;]*);url=(.*)/) { $url_stat{$6}{hits} = $1; $url_stat{$6}{bytes} = $2; $url_stat{$6}{duration} = $3; $url_stat{$6}{firsthit} = $4 if (!$url_stat{$6}{firsthit} || ($4 < $url_stat{$6}{firsthit})); $url_stat{$6}{lasthit} = $5 if (!$url_stat{$6}{lasthit} || ($5 > $url_stat{$6}{lasthit})); $total_hit += $1; $total_bytes += $2; $total_duration += $3; } elsif ($data =~ /hits=(\d+);bytes=(\d+);duration=(\d+);url=(.*)/) { $url_stat{$4}{hits} = $1; $url_stat{$4}{bytes} = $2; $url_stat{$4}{duration} = $3; $total_hit += $1; $total_bytes += $2; $total_duration += $3; } } $infile->close(); my $nurl = scalar keys %url_stat; print $$out qq{

$Translate{'Url_number'}: $nurl

}; print $$out qq{ } if ($type eq 'hour'); print $$out qq{ } if ($self->{CostPrice}); print $$out qq{ }; foreach my $url (sort { $url_stat{$b}{"$self->{OrderUrl}"} <=> $url_stat{$a}{"$self->{OrderUrl}"} } keys %url_stat) { my $h_percent = '0.0'; $h_percent = sprintf("%2.2f", ($url_stat{$url}{hits}/$total_hit) * 100) if ($total_hit); my $b_percent = '0.0'; $b_percent = sprintf("%2.2f", ($url_stat{$url}{bytes}/$total_bytes) * 100) if ($total_bytes); my $d_percent = '0.0'; $d_percent = sprintf("%2.2f", ($url_stat{$url}{duration}/$total_duration) * 100) if ($total_duration); $url_stat{$url}{duration} = &parse_duration(int($url_stat{$url}{duration}/1000)); my $total_cost = sprintf("%2.2f", int($url_stat{$url}{bytes}/1000000) * $self->{CostPrice}); my $comma_bytes = $self->format_bytes($url_stat{$url}{bytes}); my $firsthit = '-'; if ($url_stat{$url}{firsthit}) { $firsthit = ucfirst(strftime("%b %d %T", localtime($url_stat{$url}{firsthit}))); } my $lasthit = '-'; if ($url_stat{$url}{lasthit}) { $lasthit = ucfirst(strftime("%b %d %T", localtime($url_stat{$url}{lasthit}))); } if ($type eq 'hour') { if ($url_stat{$url}{firsthit}) { $firsthit = ucfirst(strftime("%T", localtime($url_stat{$url}{firsthit}))); } else { $firsthit = '-'; } if ($url_stat{$url}{lasthit}) { $lasthit = ucfirst(strftime("%T", localtime($url_stat{$url}{lasthit}))); } else { $firsthit = '-'; } } print $$out qq{ }; print $$out qq{ } if ($type eq 'hour'); print $$out qq{ } if ($self->{CostPrice}); print $$out qq{ }; } my $sortpos = 1; $sortpos = 2 if ($self->{OrderUrl} eq 'bytes'); $sortpos = 3 if ($self->{OrderUrl} eq 'duration'); print $$out qq{
$Translate{'Url'} $Translate{'Requests'} (%) $Translate{$self->{TransfertUnit}} (%) $Translate{'Duration'} (%)$Translate{'First_visit'} $Translate{'Last_visit'}$Translate{'Cost'} $self->{Currency}
$url $url_stat{$url}{hits} ($h_percent) $comma_bytes ($b_percent) $url_stat{$url}{duration} ($d_percent)$firsthit $lasthit$total_cost
}; } sub _print_top_url_stat { my ($self, $outdir, $year, $month, $day, $week) = @_; my $stat_date = $self->set_date($year, $month, $day); my $type = 'hour'; if (!$day) { $type = 'day'; } if (!$month) { $type = 'month'; } if ($week) { $type = 'day'; } # Load code statistics my $infile = new IO::File; $infile->open("$outdir/stat_user_url.dat") || return; my %url_stat = (); my $total_hits = 0; my $total_bytes = 0; my $total_duration = 0; my $total_cache_hit = 0; my $total_cache_bytes = 0; while(my $l = <$infile>) { chomp($l); my ($user, $data) = split(/\s/, $l); if ($data =~ /hits=(\d+);bytes=(\d+);duration=(\d+);first=([^;]*);last=([^;]*);url=(.*?);cache_hit=(\d*);cache_bytes=(\d*)/) { $url_stat{$6}{hits} = $1; $url_stat{$6}{bytes} = $2; $url_stat{$6}{duration} = $3; $url_stat{$6}{firsthit} = $4 if (!$url_stat{$6}{firsthit} || ($4 < $url_stat{$6}{firsthit})); $url_stat{$6}{lasthit} = $5 if (!$url_stat{$6}{lasthit} || ($5 > $url_stat{$6}{lasthit})); $url_stat{$6}{cache_hit} = $7; $url_stat{$6}{cache_bytes} = $8; $total_hits += $1; $total_bytes += $2; $total_duration += $3; $total_cache_hit += $7; $total_cache_bytes += $8; } elsif ($data =~ /hits=(\d+);bytes=(\d+);duration=(\d+);first=([^;]*);last=([^;]*);url=(.*)/) { $url_stat{$6}{hits} = $1; $url_stat{$6}{bytes} = $2; $url_stat{$6}{duration} = $3; $url_stat{$6}{firsthit} = $4 if (!$url_stat{$6}{firsthit} || ($4 < $url_stat{$6}{firsthit})); $url_stat{$6}{lasthit} = $5 if (!$url_stat{$6}{lasthit} || ($5 > $url_stat{$6}{lasthit})); $url_stat{$6}{users}{$user}++ if ($self->{TopUrlUser}); $total_hits += $1; $total_bytes += $2; $total_duration += $3; } elsif ($data =~ /hits=(\d+);bytes=(\d+);duration=(\d+);url=(.*)/) { $url_stat{$4}{hits} = $1; $url_stat{$4}{bytes} = $2; $url_stat{$4}{duration} = $3; $url_stat{$4}{users}{$user}++ if ($self->{TopUrlUser}); $total_hits += $1; $total_bytes += $2; $total_duration += $3; } } $infile->close(); my $nurl = scalar keys %url_stat; my $file = $outdir . '/url.html'; my $out = new IO::File; $out->open(">$file") || $self->localdie("ERROR: Unable to open $file. $!\n"); my $sortpos = 1; $sortpos = 2 if ($self->{OrderUrl} eq 'bytes'); $sortpos = 3 if ($self->{OrderUrl} eq 'duration'); # Print the HTML header my $cal = $self->_get_calendar($stat_date, $type, $outdir); $cal = '' if ($week); $self->_print_header(\$out, $self->{menu}, $cal, 100); print $out "

$Translate{'Url_number'}: $nurl

\n"; for my $tpe ('Hits', 'Bytes', 'Duration') { my $t1 = $Translate{"Url_${tpe}_title"}; $t1 =~ s/\%d/$self->{TopNumber}/; if ($tpe eq 'Hits') { print $out $self->_print_title($t1, $stat_date, $week); } else { print $out "

$t1 $stat_date

\n"; } print $out qq{ }; print $out qq{ } if ($type eq 'hour'); print $out qq{ } if ($self->{CostPrice}); print $out qq{ }; my $i = 0; foreach my $u (sort { $url_stat{$b}{"\L$tpe\E"} <=> $url_stat{$a}{"\L$tpe\E"} } keys %url_stat) { my $h_percent = '0.0'; $h_percent = sprintf("%2.2f", ($url_stat{$u}{hits}/$total_hits) * 100) if ($total_hits); my $b_percent = '0.0'; $b_percent = sprintf("%2.2f", ($url_stat{$u}{bytes}/$total_bytes) * 100) if ($total_bytes); my $d_percent = '0.0'; $d_percent = sprintf("%2.2f", ($url_stat{$u}{duration}/$total_duration) * 100) if ($total_duration); my $total_cost = sprintf("%2.2f", int($url_stat{$u}{bytes}/1000000) * $self->{CostPrice}); my $duration = &parse_duration(int($url_stat{$u}{duration}/1000)); my $comma_bytes = $self->format_bytes($url_stat{$u}{bytes}); my $firsthit = '-'; if ($url_stat{$u}{firsthit}) { $firsthit = ucfirst(strftime("%b %d %T", localtime($url_stat{$u}{firsthit}))); } my $lasthit = '-'; if ($url_stat{$u}{lasthit}) { $lasthit = ucfirst(strftime("%b %d %T", localtime($url_stat{$u}{lasthit}))); } if ($type eq 'hour') { if ($url_stat{$u}{firsthit}) { $firsthit = ucfirst(strftime("%T", localtime($url_stat{$u}{firsthit}))); } else { $firsthit = '-'; } if ($url_stat{$u}{lasthit}) { $lasthit = ucfirst(strftime("%T", localtime($url_stat{$u}{lasthit}))); } else { $firsthit = '-'; } } print $out " }; print $out qq{ } if ($type eq 'hour'); print $out qq{ } if ($self->{CostPrice}); print $out qq{ }; $i++; last if ($i > $self->{TopNumber}); } print $out qq{
$Translate{'Url'} $Translate{'Requests'} (%) $Translate{$self->{TransfertUnit}} (%) $Translate{'Duration'} (%)$Translate{'First_visit'} $Translate{'Last_visit'}$Translate{'Cost'} $self->{Currency}
\n"; if (exists $url_stat{$u}{users}) { print $out qq{ $url_stat{$u}{hits} ($h_percent) $comma_bytes ($b_percent) $duration ($d_percent)$firsthit $lasthit$total_cost
}; } print $out qq{ }; $self->_print_footer(\$out); $out->close(); return $nurl; } sub _print_top_domain_stat { my ($self, $outdir, $year, $month, $day, $week) = @_; my $stat_date = $self->set_date($year, $month, $day); my $type = 'hour'; if (!$day) { $type = 'day'; } if (!$month) { $type = 'month'; } if ($week) { $type = 'day'; } # Load code statistics my $infile = new IO::File; $infile->open("$outdir/stat_user_url.dat") || return; my %url_stat = (); my %domain_stat = (); my $total_hits = 0; my $total_bytes = 0; my $total_duration = 0; my %perdomain = (); my $url = ''; my $hits = 0; my $bytes = 0; my $cache_hit = 0; my $cache_bytes = 0; my $total_cache_hit = 0; my $total_cache_bytes = 0; my $duration = 0; my $first = 0; my $last = 0; my $tld_pattern1 = '(' . join('|', @TLD1) . ')'; $tld_pattern1 = qr/([^\.]+)$tld_pattern1$/; my $tld_pattern2 = '(' . join('|', @TLD2) . ')'; $tld_pattern2 = qr/([^\.]+)$tld_pattern2$/; while(my $l = <$infile>) { chomp($l); my ($user, $data) = split(/\s/, $l); if ($data =~ /hits=(\d+);bytes=(\d+);duration=(\d+);first=([^;]*);last=([^;]*);url=(.*?);cache_hit=(\d*);cache_bytes=(\d*)/) { $url = lc($6); $hits = $1; $bytes = $2; $duration = $3; $first = $4; $last = $5; $cache_hit = $7; $cache_bytes= $8; } elsif ($data =~ /hits=(\d+);bytes=(\d+);duration=(\d+);first=([^;]*);last=([^;]*);url=(.*)/) { $url = lc($6); $hits = $1; $bytes = $2; $duration = $3; $first = $4; $last = $5; } elsif ($data =~ /hits=(\d+);bytes=(\d+);duration=(\d+);url=(.*)/) { $url = $4; $hits = $1; $bytes = $2; $duration = $3; } my $done = 0; if ($url !~ /\.\d+$/) { if ($url =~ $tld_pattern1) { $domain_stat{"$1$2"}{hits} += $hits; $domain_stat{"$1$2"}{bytes} += $bytes; $domain_stat{"$1$2"}{duration} += $duration; $domain_stat{"$1$2"}{firsthit} = $first if (!$domain_stat{"$1$2"}{firsthit} || ($first < $domain_stat{"$1$2"}{firsthit})); $domain_stat{"$1$2"}{lasthit} = $last if (!$domain_stat{"$1$2"}{lasthit} || ($last > $domain_stat{"$1$2"}{lasthit})); $domain_stat{"$1$2"}{users}{$user}++ if ($self->{TopUrlUser}); $domain_stat{"$1$2"}{cache_hit} += $cache_hit; $domain_stat{"$1$2"}{cache_bytes} += $cache_bytes; $perdomain{"$2"}{hits} += $hits; $perdomain{"$2"}{bytes} += $bytes; $perdomain{"$2"}{cache_hit} += $cache_hit; $perdomain{"$2"}{cache_bytes} += $cache_bytes; $done = 1; } elsif ($url =~ $tld_pattern2) { $domain_stat{"$1$2"}{hits} += $hits; $domain_stat{"$1$2"}{bytes} += $bytes; $domain_stat{"$1$2"}{duration} += $duration; $domain_stat{"$1$2"}{firsthit} = $first if (!$domain_stat{"$1$2"}{firsthit} || ($first < $domain_stat{"$1$2"}{firsthit})); $domain_stat{"$1$2"}{lasthit} = $last if (!$domain_stat{"$1$2"}{lasthit} || ($last > $domain_stat{"$1$2"}{lasthit})); $domain_stat{"$1$2"}{users}{$user}++ if ($self->{TopUrlUser}); $domain_stat{"$1$2"}{cache_hit} += $cache_hit; $domain_stat{"$1$2"}{cache_bytes} += $cache_bytes; $perdomain{"$2"}{hits} += $hits; $perdomain{"$2"}{bytes} += $bytes; $perdomain{"$2"}{cache_hit} += $cache_hit; $perdomain{"$2"}{cache_bytes} += $cache_bytes; $done = 1; } } if (!$done) { $perdomain{'others'}{hits} += $hits; $perdomain{'others'}{bytes} += $bytes; $domain_stat{'unknown'}{hits} += $hits; $domain_stat{'unknown'}{bytes} += $bytes; $domain_stat{'unknown'}{duration} = $duration; $domain_stat{'unknown'}{firsthit} = $first if (!$domain_stat{'unknown'}{firsthit} || ($first < $domain_stat{'unknown'}{firsthit})); $domain_stat{'unknown'}{lasthit} = $last if (!$domain_stat{'unknown'}{lasthit} || ($last > $domain_stat{'unknown'}{lasthit})); $domain_stat{'unknown'}{users}{$user}++ if ($self->{TopUrlUser}); $domain_stat{'unknown'}{cache_hit} += $cache_hit; $domain_stat{'unknown'}{cache_bytes} += $cache_bytes; $perdomain{'others'}{cache_hit} += $cache_hit; $perdomain{'others'}{cache_bytes} += $cache_bytes; } $total_hits += $hits; $total_bytes += $bytes; $total_duration += $duration; $total_cache_hit += $cache_hit; $total_cache_bytes += $cache_bytes; } $infile->close(); my $nurl = scalar keys %domain_stat; my $file = $outdir . '/domain.html'; my $out = new IO::File; $out->open(">$file") || $self->localdie("ERROR: Unable to open $file. $!\n"); my $sortpos = 1; $sortpos = 2 if ($self->{OrderUrl} eq 'bytes'); $sortpos = 3 if ($self->{OrderUrl} eq 'duration'); # Print the HTML header my $cal = $self->_get_calendar($stat_date, $type, $outdir); $cal = '' if ($week); $self->_print_header(\$out, $self->{menu}, $cal, 100); print $out "

$Translate{'Domain_number'}: $nurl

\n"; $total_hits ||= 1; $total_bytes ||= 1; for my $tpe ('Hits', 'Bytes', 'Duration') { my $t1 = $Translate{"Domain_${tpe}_title"}; $t1 =~ s/\%d/$self->{TopNumber}/; if ($tpe eq 'Hits') { print $out $self->_print_title($t1, $stat_date, $week); my %data = (); foreach my $dom (keys %perdomain) { if (($perdomain{$dom}{hits}/$total_hits)*100 > $self->{MinPie}) { $data{$dom} = $perdomain{$dom}{hits}; } else { $data{'others'} += $perdomain{$dom}{hits}; } } my $title = "$Translate{'Domain_graph_hits_title'} $stat_date"; my $domain_hits = $self->flotr2_piegraph(1, 'domain_hits', $title, $Translate{'Domains_graph'}, '', %data); %data = (); foreach my $dom (keys %domain_stat) { if (($domain_stat{$dom}{hits}/$total_hits)*100 > $self->{MinPie}) { $data{$dom} = $domain_stat{$dom}{hits}; } else { $data{'others'} += $domain_stat{$dom}{hits}; } } my $title2 = "$Translate{'Second_domain_graph_hits_title'} $stat_date"; my $domain2_hits = $self->flotr2_piegraph(1, 'second_domain_hits', $title2, $Translate{'Domains_graph'}, '', %data); print $out qq{}; $domain_hits = ''; $domain2_hits = ''; %data = (); foreach my $dom (keys %perdomain) { if (($perdomain{$dom}{bytes}/$total_bytes)*100 > $self->{MinPie}) { $data{$dom} = $perdomain{$dom}{bytes}; } else { $data{'others'} += $perdomain{$dom}{bytes}; } } $title = "$Translate{'Domain_graph_bytes_title'} $stat_date"; my $domain_bytes = $self->flotr2_piegraph(1, 'domain_bytes', $title, $Translate{'Domains_graph'}, '', %data); %data = (); foreach my $dom (keys %domain_stat) { if (($domain_stat{$dom}{bytes}/$total_bytes)*100 > $self->{MinPie}) { $data{$dom} = $domain_stat{$dom}{bytes}; } else { $data{'others'} += $domain_stat{$dom}{bytes}; } } $title2 = "$Translate{'Second_domain_graph_bytes_title'} $stat_date"; my $domain2_bytes = $self->flotr2_piegraph(1, 'second_domain_bytes', $title2, $Translate{'Domains_graph'}, '', %data); print $out qq{
$domain_hits$domain2_hits
$domain_bytes$domain2_bytes
}; $domain_bytes = ''; $domain2_bytes = ''; %data = (); } else { print $out "

$t1 $stat_date

\n"; } print $out qq{ }; print $out qq{ } if ($type eq 'hour'); print $out qq{ } if ($self->{CostPrice}); print $out qq{ }; my $i = 0; foreach my $u (sort { $domain_stat{$b}{"\L$tpe\E"} <=> $domain_stat{$a}{"\L$tpe\E"} } keys %domain_stat) { my $h_percent = '0.0'; $h_percent = sprintf("%2.2f", ($domain_stat{$u}{hits}/$total_hits) * 100) if ($total_hits); my $b_percent = '0.0'; $b_percent = sprintf("%2.2f", ($domain_stat{$u}{bytes}/$total_bytes) * 100) if ($total_bytes); my $d_percent = '0.0'; $d_percent = sprintf("%2.2f", ($domain_stat{$u}{duration}/$total_duration) * 100) if ($total_duration); my $total_cost = sprintf("%2.2f", int($domain_stat{$u}{bytes}/1000000) * $self->{CostPrice}); my $duration = &parse_duration(int($domain_stat{$u}{duration}/1000)); my $comma_bytes = $self->format_bytes($domain_stat{$u}{bytes}); my $firsthit = '-'; if ($domain_stat{$u}{firsthit}) { $firsthit = ucfirst(strftime("%b %d %T", localtime($domain_stat{$u}{firsthit}))); } my $lasthit = '-'; if ($domain_stat{$u}{lasthit}) { $lasthit = ucfirst(strftime("%b %d %T", localtime($domain_stat{$u}{lasthit}))); } if ($type eq 'hour') { if ($domain_stat{$u}{firsthit}) { $firsthit = ucfirst(strftime("%T", localtime($domain_stat{$u}{firsthit}))); } else { $firsthit = '-'; } if ($domain_stat{$u}{lasthit}) { $lasthit = ucfirst(strftime("%T", localtime($domain_stat{$u}{lasthit}))); } else { $lasthit = '-'; } } print $out " }; print $out qq{ } if ($type eq 'hour'); print $out qq{ } if ($self->{CostPrice}); print $out qq{ }; $i++; last if ($i > $self->{TopNumber}); } print $out qq{
$Translate{'Url'} $Translate{'Requests'} (%) $Translate{$self->{TransfertUnit}} (%) $Translate{'Duration'} (%)$Translate{'First_visit'} $Translate{'Last_visit'}$Translate{'Cost'} $self->{Currency}
\n"; if (exists $domain_stat{$u}{users}) { my $dname = "*.$u"; $dname = $u if (grep(/^$u$/i, 'localhost', 'unknown')); print $out qq{ $domain_stat{$u}{hits} ($h_percent) $comma_bytes ($b_percent) $duration ($d_percent)$firsthit $lasthit$total_cost
}; } print $out qq{ }; $self->_print_footer(\$out); $out->close(); return $nurl; } sub _gen_summary { my ($self, $outdir) = @_; # Get all day subdirectory opendir(DIR, "$outdir") or $self->localdie("ERROR: Can't read directory $outdir, $!\n"); my @dirs = grep { /^\d{4}$/ && -d "$outdir/$_" } readdir(DIR); closedir DIR; my %code_stat = (); my %total_request = (); my %total_bytes = (); foreach my $d (@dirs) { # Load code statistics my $infile = new IO::File; $infile->open("$outdir/$d/stat_code.dat") || return; while(my $l = <$infile>) { chomp($l); my ($code, $data) = split(/\s/, $l); $data =~ /hits_month=([^;]+);bytes_month=(.*)/; my $hits = $1 || ''; my $bytes = $2 || ''; $hits =~ s/,$//; $bytes =~ s/,$//; my %hits_tmp = split(/[:,]/, $hits); foreach my $tmp (sort {$a <=> $b} keys %hits_tmp) { $code_stat{$d}{$code}{request} += $hits_tmp{$tmp}; } my %bytes_tmp = split(/[:,]/, $bytes); foreach my $tmp (sort {$a <=> $b} keys %bytes_tmp) { $code_stat{$d}{$code}{bytes} += $bytes_tmp{$tmp}; } } $infile->close(); $total_request{$d} = $code_stat{$d}{HIT}{request} + $code_stat{$d}{MISS}{request}; $total_bytes{$d} = $code_stat{$d}{HIT}{bytes} + $code_stat{$d}{MISS}{bytes}; } my $file = $outdir . '/index.html'; my $out = new IO::File; $out->open(">$file") || $self->localdie("ERROR: Unable to open $file. $!\n"); # Print the HTML header $self->_print_header(\$out); my $colspn = 2; $colspn = 3 if ($self->{CostPrice}); print $out qq{

$Translate{'Globals_Statistics'}

}; print $out qq{ } if ($self->{CostPrice}); print $out qq{ }; foreach my $year (sort {$b <=> $a} keys %code_stat) { my $comma_bytes = $self->format_bytes($total_bytes{$year}); my $hit_bytes = $self->format_bytes($code_stat{$year}{HIT}{bytes}); my $miss_bytes = $self->format_bytes($code_stat{$year}{MISS}{bytes}); my $total_cost = sprintf("%2.2f", int($total_bytes{$year}/1000000) * $self->{CostPrice}); print $out qq{ }; print $out qq{} if ($self->{CostPrice}); print $out qq{}; } print $out qq{
$Translate{'Requests'} $Translate{$self->{TransfertUnit}} $Translate{'Total'}
$Translate{'Years'} $Translate{'Hit'} $Translate{'Miss'} $Translate{'Hit'} $Translate{'Miss'} $Translate{'Requests'} $Translate{$self->{TransfertUnit}}$Translate{'Cost'} $self->{Currency}
$Translate{'Stat_label'} $year * $code_stat{$year}{HIT}{request} $code_stat{$year}{MISS}{request} $hit_bytes $miss_bytes $total_request{$year} $comma_bytes$total_cost
(*) $Translate{'Click_year_stat'}

$Translate{'Legend'}

$Translate{'Hit'}: $Translate{'Hit_help'}
$Translate{'Miss'}: $Translate{'Miss_help'}
}; print $out qq{$Translate{'Cost'}: $Translate{'Cost_help'} $self->{CostPrice} $self->{Currency}
} if ($self->{CostPrice}); print $out qq{
}; $self->_print_footer(\$out); $out->close(); } sub parse_config { my ($self, $file, $log_file, $rebuild) = @_; $self->localdie("FATAL: no configuration file!\n") if (!-e $file); my %opt = (); open(CONF, $file) or $self->localdie("ERROR: can't open file $file, $!\n"); while (my $l = ) { chomp($l); next if (!$l || ($l =~ /^[\s\t]*#/)); my ($key, $val) = split(/[\s\t]+/, $l, 2); $opt{$key} = $val; } close(CONF); # Set logfile from command line if any. $opt{LogFile} = $log_file if ($log_file); # Check config if (!exists $opt{Output} || !-d $opt{Output}) { print STDERR "Error: you must give a valid output directory. See option: Output\n"; unlink($self->{pidfile}); exit 0; } if ( !$opt{LogFile} || !-f $opt{LogFile} ) { if (!$rebuild) { print STDERR "Error: you must give a valid path to the Squid log file. See LogFile or option -l\n"; unlink($self->{pidfile}); exit 0; } } if (exists $opt{DateFormat}) { if ( ($opt{DateFormat} !~ m#\%y#) || (($opt{DateFormat} !~ m#\%m#) && ($opt{DateFormat} !~ m#\%M#) )|| ($opt{DateFormat} !~ m#\%d#) ) { print STDERR "Error: bad date format: $opt{DateFormat}, must have \%y, \%m or \%M, \%d. See DateFormat option.\n"; unlink($self->{pidfile}); exit 0; } } if ($opt{Lang} && !-e $opt{Lang}) { print STDERR "Error: can't find translation file $opt{Lang}. See option: Lang\n"; unlink($self->{pidfile}); exit 0; } if ($opt{ImgFormat} && !grep(/^$opt{ImgFormat}$/, 'png','jpg')) { print STDERR "Error: unknown image format. See option: ImgFormat\n"; unlink($self->{pidfile}); exit 0; } return %opt; } sub parse_network_aliases { my ($self, $file) = @_; return if (!$file || !-f $file); my %alias = (); open(ALIAS, $file) or $self->localdie("ERROR: can't open network aliases file $file, $!\n"); my $i = 0; while (my $l = ) { chomp($l); $i++; next if (!$l || ($l =~ /^[\s\t]*#/)); $l =~ s/[\s\t]*#.*//; my @data = split(/\t+/, $l, 2); if ($#data == 1) { my @rg = split(/(?check_regex($r, "$file at line $i"); } $alias{"$r"} = $data[0]; } } else { $self->localdie("ERROR: wrong format in network aliases file $file, line $i\n"); } } close(ALIAS); return %alias; } sub parse_user_aliases { my ($self, $file) = @_; return if (!$file || !-f $file); my %alias = (); open(ALIAS, $file) or $self->localdie("ERROR: can't open user aliases file $file, $!\n"); my $i = 0; while (my $l = ) { chomp($l); $i++; next if (!$l || ($l =~ /^[\s\t]*#/)); my @data = split(/\t+/, $l, 2); $data[0] =~ s/\s+/_SPC_/g; # Replace space, they are not allowed if ($#data == 1) { my @rg = split(/(?check_regex($r, "$file at line $i"); $alias{"$r"} = $data[0]; } } else { $self->localdie("ERROR: wrong format in user aliases file $file, line $i\n"); } } close(ALIAS); return %alias; } sub parse_exclusion { my ($self, $file) = @_; return if (!$file || !-f $file); my %exclusion = (); open(EXCLUDED, $file) or $self->localdie("ERROR: can't open exclusion file $file, $!\n"); my $i = 0; while (my $l = ) { chomp($l); $i++; next if (!$l || ($l =~ /^[\s\t]*#/)); # remove comments at end of line $l =~ s/[\s\t]*#.*//; if ($l =~ m#^(USER|CLIENT|URI|NETWORK)[\s\t]+(.*)#) { my $lbl = lc($1) . 's'; my @rg = split(m#[\s\t]+#, $2); foreach my $r (@rg) { next if ($lbl eq 'networks'); $self->check_regex($r, "$file at line $i"); } push(@{$exclusion{$lbl}}, @rg); } else { # backward compatibility is not more supported $self->localdie("ERROR: wrong line format in file $file at line $i\n"); } } close(EXCLUDED); return %exclusion; } sub parse_inclusion { my ($self, $file) = @_; return if (!$file || !-f $file); my %inclusion = (); open(INCLUDED, $file) or $self->localdie("ERROR: can't open inclusion file $file, $!\n"); my $i = 0; while (my $l = ) { chomp($l); $i++; next if (!$l || ($l =~ /^[\s\t]*#/)); # remove comments at end of line $l =~ s/[\s\t]*#.*//; if ($l =~ m#^(USER|CLIENT|NETWORK)[\s\t]+(.*)#) { my $lbl = lc($1) . 's'; my @rg = split(m#[\s\t]+#, $2); foreach my $r (@rg) { next if ($lbl eq 'networks'); $self->check_regex($r, "$file at line $i"); } push(@{$inclusion{$lbl}}, @rg); } else { # backward compatibility is not more supported $self->localdie("ERROR: wrong line format in file $file at line $i\n"); } } close(INCLUDED); return %inclusion; } # User URL-encode sub escape { my ($toencode) = @_; return undef unless defined($toencode); $toencode =~ s/[^a-zA-Z0-9_.-]/_/g; return $toencode; } # Set date to user format sub set_date { my ($self, $year, $month, $day) = @_; my $date_format = $self->{DateFormat}; $date_format =~ s/\%y/$year/; $date_format =~ s/\%m/$month/; $date_format =~ s/\%d/$day/; $date_format =~ s/\%M/$Translate{$month}/; $date_format =~ s/([^\p{Letter}\p{Digit}]){2,3}/$1/; $date_format =~ s/^[^\p{Letter}\p{Digit}]+//; $date_format =~ s/[^\p{Letter}\p{Digit}]+$//; return $date_format; } # Format bytes with comma for better reading sub format_bytes { my ($self, $text) = @_; if ($self->{TransfertUnitValue} > 1) { $text = sprintf("%.2f", $text / $self->{TransfertUnitValue}); } $text = reverse $text; $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g; return scalar reverse $text; } sub _print_title { my ($self, $title, $stat_date, $week) = @_; my $week_title = ''; $week_title = " $Translate{Week} $week" if ($week); my $para = qq{

$title $stat_date$week_title

}; return $para; } sub _get_calendar { my ($self, $stat_date, $type, $outdir, $prefix) = @_; my $para = "
\n"; if ($type eq 'day') { $para .= "\n"; my @wday = qw(Mo Tu We Th Fr Sa Su); my @std_day = qw(Su Mo Tu We Th Fr Sa); my %day_lbl = (); if (exists $Translate{WeekDay}) { my @tmpwday = split(/\s+/, $Translate{WeekDay}); for (my $i = 0; $i <= $#std_day; $i++) { $day_lbl{$std_day[$i]} = $tmpwday[$i]; } } else { for (my $i = 0; $i <= $#wday; $i++) { $day_lbl{$wday[$i]} = $wday[$i]; } } $para .= ""; map { $para .= ''; } @wday; $para .= "\n"; $stat_date =~ /^(\d+)-(\d+)$/; my $year = $1 || ''; my $month = $2 || ''; my @currow = ('','','','','','',''); my %weeks_num = (); my $wn = ''; my $wd = ''; for my $d ("01" .. "31") { $wn = &get_week_number($year,$month,$d); next if ($wn == -1); $wd = &get_day_of_week($year,$month,$d); next if ($wd == -1); if (-f "$outdir/$d/index.html") { $currow[$wd-1] = ""; } else { $currow[$wd-1] = ""; } if ($wd == 7) { map { $_ = "" if ($_ eq ''); } @currow; @{$weeks_num{$wn}} = @currow; @currow = ('','','','','','',''); } } if ( ($wd < 7) && ($wd != -1) && ($wn != -1) ) { map { $_ = "" if ($_ eq ''); } @currow; @{$weeks_num{$wn}} = @currow; } my $path = $outdir; $path =~ s/(\/\d{4})\/\d{2}.*/$1/; foreach my $w (sort { $a <=> $b } keys %weeks_num) { my $ww = sprintf("%02d", $w+1); my $week = ""; if (-d "$path/week$ww") { $week = ""; } $para .= $week . join('', @{$weeks_num{$w}}) . "\n"; } $para .= "
$stat_date
 ' . $day_lbl{$_} . '
$d$d  
$ww
{WebUrl}/$year/week$ww\">$ww
\n"; } elsif ($type eq 'month') { $para .= "\n"; for my $i ('01' .. '12') { $para .= "" if (grep(/^$i$/, '01', '04', '07','10')); if (-f "$outdir/$i/index.html") { $para .= ""; } else { $para .= ""; } $para .= "\n" if (grep(/^$i$/, '03', '06', '09', '12')); } $para .= "
$stat_date
$Translate{$i}$Translate{$i}
\n"; } $para .= "
\n"; return $para; } sub anonymize_id { my $u_id = ''; while (length($u_id) < 16) { my $c = chr(int(rand(127))); if ($c =~ /[a-zA-Z0-9]/) { $u_id .= $c; } } return 'Anon' . $u_id; } sub flotr2_bargraph { my ($self, $buttonid, $divid, $xtype, $title, $xtitle, $ytitle, $data1, $legend1, $data2, $legend2, $data3, $legend3, $data4, $legend4) = @_; my @legend = (); my @data = (); my $i = 0; push(@data, "var d1 = [$data1];\n") if ($data1); push(@legend, "{ data: d1, label: \"$legend1\", color: \"$GRAPH_COLORS[$i++]\", mouse:{track:true} },\n") if ($data1); push(@data, "var d2 = [$data2];\n") if ($data2); push(@legend, "{ data: d2, label: \"$legend2\", color: \"$GRAPH_COLORS[$i++]\", mouse:{track:true} },\n") if ($data2); push(@data, "var d3 = [$data3];\n") if ($data3); push(@legend, "{ data: d3, label: \"$legend3\", color: \"$GRAPH_COLORS[$i++]\", mouse:{track:true} },\n") if ($data3); push(@data, "var d4 = [$data4];\n") if ($data4); push(@legend, "{ data: d4, label: \"$legend4\", color: \"$GRAPH_COLORS[$i++]\", mouse:{track:true} },\n") if ($data4); my $month_array = ''; my $xlabel = ''; my $numticks = 0; my $xmode = 'normal'; if ($xtype eq 'month') { $month_array = qq{var months = [ '$Translate{"01"}', '$Translate{"02"}', '$Translate{"03"}', '$Translate{"04"}', '$Translate{"05"}', '$Translate{"06"}', '$Translate{"07"}', '$Translate{"08"}', '$Translate{"09"}', '$Translate{"10"}', '$Translate{"11"}', '$Translate{"12"}' ]; }; $xlabel = qq{return months[(pos -1) % 12];}; $numticks = 12; } elsif ($xtype eq 'day') { $xlabel = qq{var days = [01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31]; return days[(pos - 1) % 31]; }; $numticks = 31; } elsif ($xtype =~ /\[.*\]/) { $xmode = 'time'; $numticks = 7; } else { $xlabel = qq{var hours = [00,01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,21,22,23]; return hours[pos % 24]; }; $numticks = 24; } my $tickFormatter = qq{ tickFormatter: function(x) { var pos = parseInt(x); $xlabel }, }; $tickFormatter = '' if ($xmode eq 'time'); my $dateTracker_lblopts = ''; map { if (/label: "([^"]+)"/) { $dateTracker_lblopts .= "'$1',"; } } @legend; $dateTracker_lblopts =~ s/,$//; $dateTracker_lblopts = "[$dateTracker_lblopts]"; my $dateTracker_dataopts = ''; map { if (/var (d\d+) =/) { $dateTracker_dataopts .= "$1,"; } } @data; $dateTracker_dataopts =~ s/,$//; $dateTracker_dataopts = "[$dateTracker_dataopts]"; return < EOF } sub flotr2_piegraph { my ($self, $buttonid, $divid, $title, $xlabel, $ylabel, %data) = @_; my @datadef = (); my @contdef = (); my $i = 1; foreach my $k (sort {$data{$b} <=> $data{$a} } keys %data) { push(@datadef, "var d$i = [ [0,$data{$k}] ];\n"); push(@contdef, "{ data: d$i, label: \"$k\" },\n"); $i++; } return < EOF } sub check_regex { my ($self, $pattern, $label) = @_; eval { $pattern =~ m/^$pattern$/i;}; if ($@) { $self->localdie("FATAL: $label invalid regex '$pattern', $!\n"); } } sub check_ip { my ($ip, $block) = @_; my @ip = split(/\./, $ip); my $ip1 = $ip[0] * 2**24 + $ip[1] * 2**16 + $ip[2] * 2**8 + $ip[3]; my @submask = split(/\//, $block); my $ip2 = $submask[0]; my $netmask = $submask[1]; my @ip2 = split(/\./, $ip2); $ip2 = $ip2[0] * 2**24 + $ip2[1] * 2**16 + $ip2[2] * 2**8 + $ip2[3]; if ( $ip1 >> (32-$netmask) == $ip2 >> (32-$netmask)) { return 1; } return 0; } sub _gen_year_summary { my ($self, $outdir) = @_; # Get all day subdirectory opendir(DIR, "$outdir") or $self->localdie("ERROR: Can't read directory $outdir, $!\n"); my @dirs = grep { /^\d{4}$/ && -d "$outdir/$_" } readdir(DIR); closedir DIR; my %code_stat = (); my %total_request = (); my %total_bytes = (); foreach my $d (@dirs) { $code_stat{$d} = 1; } my $file = $outdir . '/index.html'; my $out = new IO::File; $out->open(">$file") || $self->localdie("ERROR: Unable to open $file. $!\n"); # Print the HTML header $self->_print_header(\$out); my $colspn = 2; $colspn = 3 if ($self->{CostPrice}); print $out qq{

$Translate{'Globals_Statistics'}

}; foreach my $year (sort {$b <=> $a} keys %code_stat) { print $out qq{ }; } print $out qq{
$Translate{'Years'}
$Translate{'Stat_label'} $year *
(*) $Translate{'Click_year_stat'}

$Translate{'Legend'}

$Translate{'Hit'}: $Translate{'Hit_help'}
$Translate{'Miss'}: $Translate{'Miss_help'}
}; print $out qq{$Translate{'Cost'}: $Translate{'Cost_help'} $self->{CostPrice} $self->{Currency}
} if ($self->{CostPrice}); print $out qq{
}; $self->_print_footer(\$out); $out->close(); } #### # Get the week day of a date #### sub get_day_of_week { my ($year, $month, $day) = @_; # %u The day of the week as a decimal, range 1 to 7, Monday being 1. # %w The day of the week as a decimal, range 0 to 6, Sunday being 0. #my $weekDay = POSIX::strftime("%u", gmtime timelocal_nocheck(0,0,0,$day,--$month,$year)); my $weekDay = POSIX::strftime("%u", 1,1,1,$day,--$month,$year-1900); return $weekDay; } #### # Get week number #### sub get_week_number { my ($year, $month, $day) = @_; # %U The week number of the current year as a decimal number, range 00 to 53, starting with the first # Sunday as the first day of week 01. # %V The ISO 8601 week number (see NOTES) of the current year as a decimal number, range 01 to 53, # where week 1 is the first week that has at least 4 days in the new year. # %W The week number of the current year as a decimal number, range 00 to 53, starting with the first # Monday as the first day of week 01. # Check if the date is valide first my $datefmt = POSIX::strftime("%F", 1, 1, 1, $day, $month - 1, $year - 1900); if ($datefmt ne "$year-$month-$day") { return -1; } my $weekNumber = POSIX::strftime("%W", 1, 1, 1, $day, $month - 1, $year - 1900); return $weekNumber; } # Returns all days following the week number sub get_wdays_per_month { my $wn = shift; my ($year, $month) = split(/\-/, shift); my @months = (); my @retdays = (); $month ||= '01'; push(@months, "$year$month"); my $start_month = $month; if ($month eq '01') { unshift(@months, ($year - 1) . "12"); } else { unshift(@months, $year . sprintf("%02d", $month - 1)); } if ($month == 12) { push(@months, ($year+1) . "01"); } else { push(@months, $year . sprintf("%02d", $month + 1)); } foreach my $d (@months) { $d =~ /^(\d{4})(\d{2})$/; my $y = $1; my $m = $2; foreach my $day ("01" .. "31") { # Check if the date is valide first my $datefmt = POSIX::strftime("%F", 1, 1, 1, $day, $m - 1, $y - 1900); if ($datefmt ne "$y-$m-$day") { next; } my $weekNumber = POSIX::strftime("%W", 1, 1, 1, $day, $m - 1, $y - 1900); if ( ($weekNumber == $wn) || ( ($weekNumber eq '00') && (($wn == 1) || ($wn >= 52)) ) ) { push(@retdays, "$year-$m-$day"); return @retdays if ($#retdays == 6); } next if ($weekNumber > $wn); } } return @retdays; } # Returns all days following the week number sub get_wdays_per_year { my ($wn, $year) = @_; my @months = (); my @retdays = (); foreach ("01" .. "12") { push(@months, "$year$_"); } my $start_month = "01";; unshift(@months, ($year - 1) . "12"); push(@months, ($year+1) . "01"); foreach my $d (@months) { $d =~ /^(\d{4})(\d{2})$/; my $y = $1; my $m = $2; foreach my $day ("01" .. "31") { # Check if the date is valide first my $datefmt = POSIX::strftime("%F", 1, 1, 1, $day, $m - 1, $y - 1900); if ($datefmt ne "$y-$m-$day") { next; } my $weekNumber = POSIX::strftime("%W", 1, 1, 1, $day, $m - 1, $y - 1900); if ( ($weekNumber == $wn) || ( ($weekNumber eq '00') && (($wn == 1) || ($wn >= 52)) ) ) { my $time = timelocal_nocheck(0, 0, 0, $day, $m - 1, $y - 1900); push(@retdays, $time*1000); return @retdays if ($#retdays == 6); } next if ($weekNumber > $wn); } } return @retdays; } 1; __END__