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
|
# -*- perl -*-
#
# Net::Server::Proto::UNIXDGRAM - Net::Server Protocol module
#
# Copyright (C) 2001-2022
#
# Paul Seamons <paul@seamons.com>
#
# This package may be distributed under the terms of either the
# GNU General Public License
# or the
# Perl Artistic License
#
# All rights reserved.
#
################################################################
package Net::Server::Proto::UNIXDGRAM;
use strict;
use base qw(Net::Server::Proto::UNIX);
use Socket qw(SOCK_DGRAM);
my @udp_args = qw(
udp_recv_len
udp_recv_flags
udp_broadcast
); # we do broadcast just for caching parallelism with UDP.pm
sub NS_proto { 'UNIXDGRAM' }
sub NS_recv_len { my $sock = shift; ${*$sock}{'NS_recv_len'} = shift if @_; return ${*$sock}{'NS_recv_len'} }
sub NS_recv_flags { my $sock = shift; ${*$sock}{'NS_recv_flags'} = shift if @_; return ${*$sock}{'NS_recv_flags'} }
sub NS_unix_type { 'SOCK_DGRAM' }
sub object {
my ($class, $info, $server) = @_;
my $udp = $server->{'server'}->{'udp_args'} ||= do {
my %temp = map {$_ => undef} @udp_args;
$server->configure({map {$_ => \$temp{$_}} @udp_args});
\%temp;
};
my $len = defined($info->{'udp_recv_len'}) ? $info->{'udp_recv_len'}
: defined($udp->{'udp_recv_len'}) ? $udp->{'udp_recv_len'}
: 4096;
$len = ($len =~ /^(\d+)$/) ? $1 : 4096;
my $flg = defined($info->{'udp_recv_flags'}) ? $info->{'udp_recv_flags'}
: defined($udp->{'udp_recv_flags'}) ? $udp->{'udp_recv_flags'}
: 0;
$flg = ($flg =~ /^(\d+)$/) ? $1 : 0;
my $sock = $class->SUPER::new();
my $port = $info->{'port'} =~ m{^ ([\w\.\-\*\/]+) $ }x ? $1 : $server->fatal("Insecure filename");
$sock->NS_port($port);
$sock->NS_recv_len($len);
$sock->NS_recv_flags($flg);
return $sock;
}
sub connect {
my ($sock, $server) = @_;
my $path = $sock->NS_port;
$server->fatal("Can't connect to UNIXDGRAM socket at file $path [$!]") if -e $path && ! unlink $path;
$sock->SUPER::configure({
Local => $path,
Type => SOCK_DGRAM,
}) or $server->fatal("Can't connect to UNIXDGRAM socket at file $path [$!]");
}
1;
__END__
=head1 NAME
Net::Server::Proto::UNIXDGRAM - Net::Server UNIXDGRAM protocol.
=head1 SYNOPSIS
See L<Net::Server::Proto>.
=head1 DESCRIPTION
Protocol module for Net::Server. This module implements the UNIX
SOCK_DGRAM socket type. See L<Net::Server::Proto>.
Any sockets created during startup will be chown'ed to the user and
group specified in the startup arguments.
=head1 PARAMETERS
The following parameters may be specified in addition to normal
command line parameters for a Net::Server. See L<Net::Server> for
more information on reading arguments.
=over 4
=item udp_recv_len
Specifies the number of bytes to read from the SOCK_DGRAM connection
handle. Data will be read into $self->{'server'}->{'udp_data'}.
Default is 4096. See L<IO::Socket::INET> and L<recv>.
=item udp_recv_flags
See L<recv>. Default is 0.
=back
=head1 QUICK PARAMETER LIST
Key Value Default
## UNIXDGRAM socket parameters
udp_recv_len \d+ 4096
udp_recv_flags \d+ 0
=head1 LICENCE
Distributed under the same terms as Net::Server
=cut
|
