File Coverage

lib/Socket/AcceptFilter.pm
Criterion Covered Total %
statement 26 31 83.8
branch 4 10 40.0
condition 1 3 33.3
subroutine 8 8 100.0
pod 1 1 100.0
total 40 53 75.4


line stmt bran cond sub pod time code
1             package Socket::AcceptFilter;
2              
3 3     3   119941 use 5.008008;
  3         13  
  3         137  
4 3     3   17 use strict;
  3         7  
  3         88  
5 3     3   15 use warnings;
  3         13  
  3         80  
6 3     3   15 use Carp;
  3         16  
  3         3305  
7 3     3   4628 use Socket qw(SOL_SOCKET IPPROTO_TCP);
  3         22315  
  3         1878  
8 3     3   111 use Exporter;
  3         39  
  3         620  
9              
10             our @EXPORT = qw(accept_filter);
11             *import = \&Exporter::import;
12              
13             =head1 NAME
14              
15             Socket::AcceptFilter - Set sockopt httpready/dataready on FreeBSD and Linux
16              
17             =head1 VERSION
18              
19             Version 0.03
20              
21             =cut
22              
23             our $VERSION = '0.03';
24              
25             =head1 SYNOPSIS
26              
27             use Socket::AcceptFilter;
28            
29             my $socket = ...;
30             listen($socket);
31             accept_filter($socket,'httpready'); # FreeBSD only
32             # or
33             accept_filter($socket,'dataready'); # FreeBSD/Linux
34              
35             =head1 FUNCTIONS
36              
37             =head2 accept_filter ($sock, $name)
38              
39             =cut
40              
41             sub accept_filter ($$;$) {
42             #define SO_ACCEPTFILTER 0x1000 # fbsd
43             #define TCP_DEFER_ACCEPT 9 # linux
44             #struct accept_filter_arg {
45             # char af_name[16];
46             # char af_arg[256-16];
47             #};
48             #setsockopt(s, IPPROTO_TCP, TCP_DEFER_ACCEPT, &yes, sizeof yes);
49 1     1 1 464 my ($fh,$name,$arg) = @_;
50 1 50       6 $arg = '' unless defined $arg;
51 1 50 33     14 if ($^O eq 'freebsd') {
    50          
52 0         0 my $aha = pack('Z16 Z240',$name,$arg);
53 0 0       0 my $rc = setsockopt
54             $fh,
55             SOL_SOCKET, 0x1000, $aha
56 3     3   5555 or carp "accept_filter($name) failed: ".({ reverse %! }->{0+$!}).": $!";
  3         4025  
  3         724  
57 0         0 return $rc;
58             }
59             elsif ($name eq 'dataready' and $^O eq 'linux') {
60 1 50       15 my $rc = setsockopt
61             $fh, IPPROTO_TCP, 9, 1
62             or carp "accept_filter($name) failed: ".({ reverse %! }->{0+$!}).": $!";
63 1         7 return $rc;
64             }
65             else {
66 0           carp("accept_filter $name not implemented for on $^O");
67 0           return;
68             }
69             }
70              
71             =head1 AUTHOR
72              
73             Mons Anderson, C<< >>
74              
75             =head1 SUPPORT
76              
77             You can find documentation for this module with the perldoc command.
78              
79             perldoc Socket::AcceptFilter
80              
81             You can also look for information at:
82              
83             =over 4
84              
85             =item * RT: CPAN's request tracker
86              
87             L
88              
89             =item * Search CPAN
90              
91             L
92              
93             =back
94              
95             =head1 COPYRIGHT & LICENSE
96              
97             Copyright 2009 Mons Anderson, all rights reserved.
98              
99             This program is free software; you can redistribute it and/or modify it
100             under the same terms as Perl itself.
101              
102             =cut
103              
104             1; # End of Socket::AcceptFilter