The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

 / 
Net-ICAP-0.04
River stage zero No dependents
/ Net::ICAP::Server

NAME

Net::ICAP::Server - ICAP Server Implementation

VERSION

$Id: lib/Net/ICAP/Server.pm, 0.04 2017/04/12 15:54:19 acorliss Exp $

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

o Paranoid
o Class::EHierarchy
o IO::Socket::INET

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)