File Coverage

blib/lib/VMPS/Server.pm
Criterion Covered Total %
statement 3 3 100.0
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 4 4 100.0


line stmt bran cond sub pod time code
1             package VMPS::Server;
2 1     1   24074 use base qw[ Net::Server::PreFork ];
  1         4  
  1         845  
3             use VMPS::Packet;
4              
5             use warnings;
6             use strict;
7              
8             =head1 NAME
9              
10             VMPS::Server - VLAN Membership Policy Server
11              
12             This package implements a VMPS server. For more information on VMPS
13             itself, consult the Cisco web site:
14              
15             http://www.cisco.com/
16              
17             =head1 VERSION
18              
19             Version 0.04
20              
21             =cut
22              
23             our $VERSION = '0.04';
24              
25              
26             =head1 SYNOPSIS
27              
28             package My::VMPSServer;
29             use base qw/VMPS::Server/;
30              
31             sub vmps_request{ ... }
32              
33             __PACKAGE__->run();
34              
35             =head1 HANDLING REQUESTS
36              
37             =head2 vmps_request()
38              
39             Child modules should implement the vmps_request method. The method should
40             return a VMPS::Packet response object. The default behavior is to reject
41             all requests. For more info, see L.
42              
43             sub vmps_request {
44             my ($this, $packet, $from_ip) = @_;
45             ....
46             return $packet->reply(...);
47             }
48              
49             =cut
50              
51             sub vmps_request {
52             my ($this, $packet, $from_ip) = @_;
53             return $packet->reject;
54             }
55              
56             =head1 DEFAULTS
57              
58             The module listens on the "vqp" port (1589/udp), on all interfaces.
59              
60             =cut
61              
62             sub default_values {
63             return {
64             port => '1589',
65             host => '*',
66             proto => 'udp',
67             }
68             }
69              
70             #################################################################
71              
72             sub process_request {
73             my $this = shift;
74             my $client = $this->{server}{client}->peerhost();
75             my $dgram = $this->{server}{udp_data};
76              
77             my $request = eval { VMPS::Packet->_decode($dgram) };
78             if ($@)
79             {
80             $this->log(1, "(Request from $client) $@");
81             return;
82             }
83              
84             eval {
85             my $reply = $this->vmps_request($request, $client);
86              
87             $reply = $request->reject
88             unless ($reply and UNIVERSAL::isa($reply, 'VMPS::Packet'));
89              
90             my $reply_pkt = $reply->_encode;
91             $this->{server}{client}->send($reply_pkt);
92             };
93             if ($@)
94             {
95             $this->log(1, "(Reply to $client) $@");
96             return;
97             }
98             }
99              
100             #################################################################
101              
102             =head1 CUSTOMIZING
103              
104             This module inherits its behavior from L. Sub-classes may
105             implement any of the hooks/arguments from Net::Server in order to
106             customize their behavior. For more information, see the documentation for
107             L.
108              
109             =head1 AUTHOR
110              
111             kevin brintnall, C<< >>
112              
113             =head1 ACKNOWLEDGEMENTS
114              
115             The packet handling code is based on VQP spec documentation from the
116             OpenVMPS project. For more information, see:
117              
118             http://vmps.sourceforge.net/
119              
120             =head1 COPYRIGHT & LICENSE
121              
122             Copyright 2008 kevin brintnall, all rights reserved.
123              
124             This program is free software; you can redistribute it and/or modify it
125             under the same terms as Perl itself.
126              
127              
128             =cut
129              
130             1; # End of VMPS::Server