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
|
#!/usr/local/bin/perl
# parse and answer ICP type 1 requests via unicast/multicast UDP
# cf. <URL:http://excalibur.usc.edu/icpdoc/icp.html>
#
# returns ICP response code, e.g. 2 == HIT, 3 == MISS, 4 == ERROR
# by looking at CERN or Netscape style cache directory $cachedir
#
# martin hamilton <m.t.hamilton@lut.ac.uk>
# Id: icpserver,v 1.11 1995/11/24 16:20:13 martin Exp martin
# usage: icpserver [-c cachedir] [-n] [-p port] [multicast_group]
#
# -c -> set cache directory
# -n -> use Netscape cache format (default is CERN)
# -p -> port number to listen on (default 3130)
# -v -> verbose - writes activitiy log to stderr
#
# group -> multicast group to listen on
require "getopts.pl";
&Getopts("c:np:v");
@CODES=("xxx", "QUERY", "HIT", "MISS", "ERROR");
$CACHEDIR=$opt_c||"/usr/local/www/cache";
$PORT=$opt_p||3130;
$SERVER=$ARGV[0]||"0.0.0.0";
$SERVERIP= ($SERVER =~ m!\d+.\d+.\d+.\d+!) ?
pack("C4", split(/\./, $SERVER)) : (gethostbyname($SERVER))[4]; # lazy!
$SOCKADDR = 'S n a4 x8';
socket(S, 2, 2, 17) || socket(S, 2, 1, 17) || die "Couldn't get socket: $!";
$us1 = pack($SOCKADDR, 2, $PORT, $SERVERIP);
$us2 = pack($SOCKADDR, 2, $PORT, pack("C4", 0,0,0,0));
bind(S, $us1) || bind(S, $us2) || die "Couldn't bind socket: $!";
#bind(S, $us2) || die "Couldn't bind socket: $!";
if ($SERVER ne "0.0.0.0") { # i.e. multicast
$whoami = (`uname -a`)[0];
$IP_ADD_MEMBERSHIP=5;
$whoami =~ /SunOS [^\s]+ 5/ && ($IP_MULTICAST_TTL=19);
$whoami =~ /IRIX [^\s]+ 5/ && ($IP_MULTICAST_TTL=23);
$whoami =~ /OSF1/ && ($IP_MULTICAST_TTL=12);
# any more funnies ?
setsockopt(S, 0, $IP_ADD_MEMBERSHIP, $SERVERIP."\0\0\0\0")
|| die "Couldn't join multicast group $SERVER: $!";
}
# Common header for ICP datagrams ... (size in bytes - total 20)
# opcode 1 Numeric code indicating type of message
# version 1 Version of the protocol being used
# length 2 Total length of packet
# reqnum 4 Request number assigned by client
# authenticator 8 Authentication information (future)
# senderid 4 Identification (host id) of sender
# Type 1 query ...
# requester 4 Host id of original requester URL
# url variable URL whose status is to be checked
# Type 2 and 3 responses just contain URL, don't return anything else
# Might be fast enough to get away without forking or non-blocking I/O ... ?
while(1) {
$theiraddr = recv(S, $ICP_request, 1024, 0);
($junk, $junk, $sourceaddr, $junk) = unpack($SOCKADDR, $theiraddr);
@theirip = unpack('C4', $sourceaddr);
$URL_length = length($ICP_request) - 24;
$request_template = 'CCnx4x8x4a4a' . $URL_length;
($type, $version, $length, $requester, $URL) =
unpack($request_template, $ICP_request);
$URL =~ s/\.\.\///g; # be cautious - any others to watch out for ?
# lookup object in cache
$hitmisserr = 3;
if ($type eq 1 && $URL =~ m!^([^:]+):/?/?([^/]+)/(.*)!) {
$scheme = $1; $hostport = $2; $path = $3;
if ($path eq "") { $path = "index.html"; }
if ($opt_n) {
($host, $port) = split(/:/, $hostport); # strip off port number
$port = ":$port" if ($port);
$match = "";
foreach (split(/\./, $hostport)) {
$match = "$_/$match"; # little-endian -> big-endian conversion
}
$match = "$CACHEDIR/hosts/$match$scheme$port.urls"; # full path
if (-f "$match") {
#### optimize! ####
open(IN, "$match") && do {
while(<IN>) { /^$URL / && ($hitmisserr = 2, last); }
close(IN);
}
}
} else {
$hitmisserr = 2 if -f "$CACHEDIR/$scheme/$hostport/$path";
}
}
print "$type $hitmisserr ", join(".", @theirip), " $URL\n" if $opt_v;
$response_template = 'CCnx4x8x4A' . length($URL);
$ICP_response =
pack($response_template, $hitmisserr, 2, 20 + length($URL), $URL);
send(S, $ICP_response, 0, $theiraddr) || die "Couldn't send request: $!";
}
|
