NAME
Net::ICAP::Server - ICAP Server Implementation
VERSION
$Id: lib/Net/ICAP/Server.pm, v0.03 $
SYNOPSIS
use Net::ICAP::Server;
use Net::ICAP::Common qw(:req);
sub cookie_monster {
my $client = shift;
my $request = shift;
my $response = new Net::ICAP::Response;
my $header = $request->method eq ICAP_REQMOD ?
$request->reqhdr : $request->reshdr;
if ($header =~ /\r\nCookie:/sm) {
# Unfold all header lines
$header =~ s/\r\n\s+/ /smg;
# Cookie Monster eat cookie... <smack>
$header =~ s/\r\nCookie:[^\r]+//smg;
# Save changes
$response->status(ICAP_OK);
$response->body($request->body);
$request->method eq ICAP_REQMOD ?
$response->reqhdr($header) :
$response->reshdr($header);
} else {
$response->status(ICAP_NO_MOD_NEEDED);
}
return $response;
}
sub my_logger {
my $client = shift;
my $request = shift;
my $response = shift;
my ($line, $header, $url);
# Assemble the URL from the HTTP header
$header = $request->method eq ICAP_REQMOD ?
$request->reqhdr : $request->reshdr;
$url = join '', reverse
($header =~ /^\S+\s+(\S+).+\r\nHost:\s+(\S+)/sm);
# Create and print the log line to STDERR
$line = sprintf( "%s %s %s: %s\n",
( scalar localtime ),
$client->peerhost, $response->status, $url );
warn $line;
}
my $server = Net::ICAP::Server->new(
addr => '192.168.0.15',
port => 1345,
max_requests => 50,
max_children => 50,
options_ttl => 3600,
services => {
'/outbound' => ICAP_REQMOD,
'/inbound' => ICAP_RESPMOD,
},
reqmod => \&cookie_monster,
respmod => \&cookie_monster,,
istag => \&my_istag_generator,
logger => \&my_logger,
);
$rv = $server->run;
DESCRIPTION
This is a very basic and crude implementation of an ICAP server. It is not intended to be the basis of a production server, but to serve as an example of a server utilizing the Net::ICAP modules.
This is a forking server capable of supporting persistent connections with optional caps in the number of simultaneous connections and the number of requests that can be performed per connection.
OPTIONS requests are handled automatically by the daemon, as are basic error responses for bad requests, services not found, and methods not implemented.
SUBROUTINES/METHODS
new
my $server = Net::ICAP::Server->new(
addr => '192.168.0.15',
port => 1345,
max_requests => 50,
max_children => 50,
options_ttl => 3600,
services => {
'/outbound' => ICAP_REQMOD,
'/inbound' => ICAP_RESPMOD,
},
reqmod => \&cookie_monster,
respmod => \&cookie_monster,,
istag => \&my_istag_generator,
logger => \&my_logger,
);
This method creates a new ICAP server. All of the arguments are technically optional, but the services hash, reqmod and/or respmod code refs are the minimum to have a functioning server.
The following chart describes the available options:
Argument Default Description
----------------------------------------------------------
addr '0.0.0.0' Address to listen on
port 1344 Port to listen on
max_requests 0 Number of requests allowed per
connection (0 == unlimited)
max_children 0 Number of simultaneous clients
allowed (0 == unlimited)
options_ttl 0 Seconds OPTIONS are good for
(0 == forever)
services () Map of service URIs to method
reqmod undef Callback function for REQMOD
respmod undef Callback function for RESPMOD
istag sub { time } ISTag generation function
logger undef Callback function for logging
reqmod and respmod functions will be called with two arguments, those being the IO::Socket::INET for the client connection and the Net::ICAP::Request object. They should return a valid Net::ICAP::Response object.
logger will be called with three arguments: the client socket object, the request and the response objects.
istag
$code = $server->istag;
Just a convenience method for pulling the ISTag generation function's code reference. Read only.
run
$rv = $server->run;
This method creates the listening socket and begins forking with each connection made it.
DEPENDENCIES
BUGS AND LIMITATIONS
This is not a full or robust implementation. This is sample code. Really. Write something better.
AUTHOR
Arthur Corliss (corliss@digitalmages.com)
LICENSE AND COPYRIGHT
This software is licensed under the same terms as Perl, itself. Please see http://dev.perl.org/licenses/ for more information.
(c) 2014, Arthur Corliss (corliss@digitalmages.com)