File: urlaliasbuilder.pl

package info (click to toggle)
awstats 6.4-1sarge3
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 4,648 kB
  • ctags: 458
  • sloc: perl: 14,780; xml: 1,288; java: 359; sh: 76; makefile: 34
file content (330 lines) | stat: -rwxr-xr-x 10,535 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
#!/usr/bin/perl
#-------------------------------------------------------
# Small script to auto-generate URL Alias files for 5.2+ AWStats
# Requires two Perl modules below.
# From original title-grabber.pl file
# 		(Feedback/suggestions to: simonjw@users.sourceforge.net)
# Modified by eldy@users.sourceforge.net
# 
# Note: If you want to retrieve document titles over SSL you must have OpenSSL and
#       the Net::SSL(eay) Perl Module available.  This code will check that SSL is
#		supported before attempting to retrieve via it.
#-------------------------------------------------------
use LWP::UserAgent;
use HTML::TokeParser;

use strict;no strict "refs";


# variables, etc
my $REVISION='$Revision: 1.6 $'; $REVISION =~ /\s(.*)\s/; $REVISION=$1;
my $VERSION="1.0 (build $REVISION)";

############### EDIT HERE ###############

# you can set this manually if you will only grep one site
my $SITECONFIG = "";

# Where the default input is located.
my $awStatsDataDir = "/var/lib/awstats";

# Throttle HTTP requests - help avoid DoS-like results if on a quick network.
# Number is the number of seconds to pause between requests. Set to zero for
# no throttling.
my $throttleRequestsTime = 0;

# LWP settings
# UA string passed to server.  You should add this to SkipUserAgents in the
# awstats.conf file if you want to ignore hits from this code.
my $userAgent = "urlaliasbuilder/$VERSION";
# Put a sensible e-mail address here
my $spiderOwner = "spider\@mydomain.com";

# Timeout (in seconds) for each HTTP request (increase on slow connections)
my $getTimeOut = 2;
# Proxy server to use when doing http/s - leave blank if you don't have one
#my $proxyServer = "http://my.proxy.server:port/";
my $proxyServer = "";
# Hosts not to use a proxy for
my @hostsNoProxy = ("host1","host1.my.domain.name");
# Make sure we don't download multi-megabyte files! We need only head section
my $maxDocSizeBytes = 4096; # number is bytes

############### DON'T EDIT BELOW HERE ###############

# Don't edit these
my $FILEMARKER1 = "BEGIN_SIDER";
my $FILEMARKER2 = "END_SIDER";

my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

my $fullMonth = sprintf("%02d",$mon+1);
my $fullYear = sprintf("%04d",$year+1900);


# ====== main ======

# Change default value if options are used
my $helpfound=0;
my $nohosts=0;
my $overwritedata=0;
my $hostname="";
my $useHTTPS=0;

# Data file to open
my $fileToOpen = $awStatsDataDir . "/awstats" . $fullMonth . $fullYear . ($SITECONFIG?".$SITECONFIG":"") . ".txt";
# URL Alias file to open
my $urlAliasFile = "urlalias" . ($SITECONFIG?".$SITECONFIG":"") . ".txt";

for (0..@ARGV-1) {
	if ($ARGV[$_] =~ /^-*urllistfile=([^\s&]+)/i) 	{ $fileToOpen="$1"; next; }
	if ($ARGV[$_] =~ /^-*urlaliasfile=([^\s&]+)/i) 	{ $urlAliasFile="$1"; next; }
	if ($ARGV[$_] =~ /^-*site=(.*)/i)      			{ $hostname="$1"; next; }
	if ($ARGV[$_] =~ /^-*h/i)     		  			{ $helpfound=1; next; }
	if ($ARGV[$_] =~ /^-*overwrite/i)     	 		{ $overwritedata=1; next; }
	if ($ARGV[$_] =~ /^-*secure/i)     	 			{ $useHTTPS=1; next; }	
}

# if no host information provided, we bomb out to usage
if(! $hostname && ! $SITECONFIG) { $nohosts=1; }

# if no hostname set (i.e. -site=) then we use the config value
if(! $hostname && $SITECONFIG) { $hostname=$SITECONFIG; }

# Show usage help
my $DIR; my $PROG; my $Extension;
($DIR=$0) =~ s/([^\/\\]*)$//; ($PROG=$1) =~ s/\.([^\.]*)$//; $Extension=$1;
if ($nohosts || $helpfound || ! @ARGV) {
	print "\n----- $PROG $VERSION -----\n";
	print ucfirst($PROG)." generates an 'urlalias' file from an input file.\n";
	print "The input file must contain a list of URLs (It can be an AWStats history file).\n";
	print "For each of thoose URLs, the script get the corresponding HTML page and catch the\n";
	print "header information (title), then it writes an output file that contains one line\n";
	print "for each URLs and several fields:\n";
	print "- The first field is the URL,\n";
	print "- The second is title caught from web page.\n";
	print "This resulting file can be used by AWStats urlalias plugin.\n";
	print "\n";
	print "Usage:  $PROG.$Extension  -site=www.myserver.com  [options]\n";
	print "\n";
	print "The site parameter contains the web server to get the page from.\n";
	print "Where options are:\n";
	print "  -urllistfile=Input urllist file\n";
	print "    If this file is an AWStats history file then urlaliasbuilder will use the\n";
	print "    SIDER section of this file as its input URL's list.\n";
	print "  -urlaliasfile=Output urlalias file to build\n";
	print "  -overwrite    Overwrite output file if exists\n";
	print "  -secure       Use https protocol\n";
	print "\n";
	print "Example: $PROG.$Extension -site=www.someotherhost.com\n";
	print "\n";
	print "This is default configuration used when no option are provided on command line:\n";
	print "Input urllist file: $fileToOpen (overwritten by -urllistfile option)\n";
	print "Output urlalias file: $urlAliasFile (overwritten by -urlaliasfile option)\n";
	print "\n";	
	print "This script was written from Simon Waight original works title-grabber.pl.\n";
	print "\n";
	exit 0;
}

my @archivedKeys=();
my $counter = 0;
my $pageTitle = "";

# only read the alias file if we want to do a comparison
# and append new items only (i.e. not overwrite)
if($overwritedata == 0) {
	open(FILE,$urlAliasFile);
	my @bits = ();
	while(<FILE>) {
		chomp $_; s/\r//;
		@bits=split(/\t/,$_);
		@archivedKeys[$counter]=@bits[0];
		$counter++;
		#print "key: " . @bits[0] . "\n";
	}
	close(FILE);
	@bits = ();
}

# open input file (might be an AWStats history data file)
print "Reading input file: $fileToOpen\n";
open(FILE,$fileToOpen) || die "Error: Can't open input urllist file $fileToOpen";
binmode FILE;

my @field=();
my @addToAliasFile=();
my $addToAliasFileCount=0;
my $isawstatshistoryfile=0;
while (<FILE>) {
	chomp $_; s/\r//;

	if ($_ =~ /^AWSTATS DATA FILE/) {
		print "This file looks like an AWStats history file. Searching URLs list...\n";
		$isawstatshistoryfile=1;
	}

	# Split line out into fields
	@field=split(/\s+/,$_);
	if (! $field[0]) { next; }

	# If we're at the start of the URL section of file
	if (! $isawstatshistoryfile || $field[0] eq $FILEMARKER1)  {

		$_=<FILE>;
		chomp $_; s/\r//;

		my @field=split(/\s+/,$_);
		my $count=0;
		my $matched = 0;
		while ($field[0] ne $FILEMARKER2) {
			if ($field[0]) {
				# compare awstats data entry against urlalias entry
				# only if we don't just want to write current items
				# to the file (i.e. overwrite)
				if($overwritedata == 0) {
					foreach my $key (@archivedKeys) {
						if($field[0] eq $key) {
							$matched = 1;
							last;
						}
					}
					# it's a new URL, so add to list of items to retrieve
					if($matched == 0) {
						@addToAliasFile[$addToAliasFileCount] = $field[0];
						$addToAliasFileCount++;
						#print "new: " . $field[0] . "\n"
					}
					$matched = 0;
				} else {
					# no comparison, so everything is 'new'
					@addToAliasFile[$addToAliasFileCount] = $field[0];
					$addToAliasFileCount++;
				}
			}
			$_=<FILE>;
			chomp $_; s/\r//;
			@field=split(/\s+/,$_);
		}
	}
}

close(FILE);

if($addToAliasFileCount == 0) {
	print "Found no new documents.\n\n" ;
	exit();
}

print "Found " . $addToAliasFileCount . " new documents with no alias.\n";

my $fileOutput = "";

print "Looking thoose pages on web site '$hostname' to get alias...\n";

# Create a user agent (browser) object
my $ua = new LWP::UserAgent;
# set user agent name
$ua->agent($userAgent);
# set user agents owners e-mail address
$ua->from($spiderOwner);
# set timeout for requests
$ua->timeout($getTimeOut);
if ($proxyServer) {
	# set proxy for access to external sites
	$ua->proxy(["http","https"],$proxyServer);
	# avoid proxy for these hosts
	$ua->no_proxy(@hostsNoProxy);
}
# set maximum size of document to retrieve (in bytes)
$ua->max_size($maxDocSizeBytes);
if(!($ua->is_protocol_supported('https')) && $useHTTPS) {
	print "SSL is not supported on this machine.\n\n";
	exit();
}

my $fileOutput = "";

# Now lets build the contents to write (or append) to urlalias file
foreach my $newAlias (@addToAliasFile) {
	sleep $throttleRequestsTime;
	my $newAliasEntry = &Generate_Alias_List_Entry($newAlias);
	$fileOutput .= $newAliasEntry . "\n";
}

# write the data back to urlalias file
if (! $overwritedata) {
	# Append to file
	open(FILE,">>$urlAliasFile") || die "Error: Failed to open file for writing: $_\n\n";
	print FILE $fileOutput;
	close(FILE);
} else {
	# Overwrite the file
	open(FILE,">$urlAliasFile") || die "Error: Failed to open file for writing: $_\n\n";
	foreach my $newAlias (@addToAliasFile) {
		my $newAliasEntry = &Generate_Alias_List_Entry($newAlias);
		print FILE "$newAliasEntry\n";
	}
	close(FILE);
}
print "File $urlAliasFile created/updated.\n";

exit();

#--------------------------- End of Main -----------------------------


#
# Generate new lines for urlalias file by doing a http get using data
# supplied.
#
sub Generate_Alias_List_Entry {

	# take in the path & document
	my $urltoget = shift;

	my $urlPrefix = "http://";
	
	if($useHTTPS) {
		$urlPrefix = "https://";
	}

	my $AliasLine = "";
	$pageTitle = "";
	$AliasLine = $urltoget;
	$AliasLine .= "\t";

	# build a full HTTP request to pass to user agent
	my $fullurltoget = $urlPrefix . $hostname . $urltoget;

	# Create a HTTP request
	print "Getting page $fullurltoget\n";
		
	my $req = new HTTP::Request GET => $fullurltoget;

	# Pass request to the user agent and get a response back
	my $res = $ua->request($req);

	# Parse returned document for page title
	if ($res->is_success()) {
		my $htmldoc = $res->content;
		my $p = HTML::Parser->new(api_version => 3);
		$p->handler( start => \&title_handler, "tagname,self");
		$p->parse($htmldoc);
	} else {
		print "Failed to get page: ".$res->status_line."\n";
		$pageTitle = "Unknown Title";
	}
	if ($pageTitle eq "") {
		$pageTitle = "Unknown Title";
	}
	return $AliasLine . $pageTitle;
}

# Handler routine for HTML::Parser
sub title_handler {
	return if shift ne "title";
	my $self = shift;
	$self->handler(text => sub { $pageTitle = shift }, "dtext");
	$self->handler(end  => sub { shift->eof if shift eq "title"; },"tagname,self");
}