← Back to branch summary

~psmay/+junk/perl-socket-mux-poc

« back to all changes in this revision

Viewing changes to server.pl

  • Committer: Peter S. May
  • Date: 2013-05-24 11:42:17 UTC
  • Revision ID: peter_s._may_httppsmay.com-20130524114217-qwck2zikrg0g00zy
Initial and broken

Show diffs side-by-side

added added

removed removed

Lines of Context:
server.pl
 
1
#!/usr/bin/perl
 
2
 
 
3
use 5.010;
 
4
use warnings;
 
5
use strict;
 
6
use Carp;
 
7
 
 
8
use Socket;
 
9
use Fcntl;
 
10
use Errno;
 
11
 
 
12
sub set_nb_flag {
 
13
        my $h = shift;
 
14
        my $flags = fcntl($socket, F_GETFL, 0) or die "fcntl F_GETFL: $!";
 
15
        fcntl($socket, F_SETFL, $flags | O_NONBLOCK) or die "fcntl F_SETFL: $!";
 
16
}
 
17
 
 
18
sub get_listening_nb_socket {
 
19
        my $path = shift;
 
20
        my $backlog = shift // SOMAXCONN;
 
21
        my $socket;
 
22
        socket($socket, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
 
23
        bind($socket, sockaddr_un($path)) or die "bind: $!";
 
24
        unlink $path or die "unlink: $!";
 
25
        listen($socket, $backlog) or die "listen: $!";
 
26
        eval { set_nb_flag($socket); };
 
27
        +($@ ne '') and die "set_nb_flag: $@";
 
28
        return $socket;
 
29
}
 
30
 
 
31
sub accept_on_nb_socket {
 
32
        my $listening_nb_socket = shift;
 
33
        my $socket;
 
34
        my $a = accept $socket, $listening_nb_socket;
 
35
        if($a) {
 
36
                set_nb_flag($socket);
 
37
                return ($socket, $a);
 
38
        }
 
39
        elsif($!{EWOULDBLOCK}) {
 
40
                # If succeeded, or if the failure is only due to nonblocking
 
41
                return ();
 
42
        }
 
43
        else {
 
44
                die "accept: $!";
 
45
        }
 
46
}
 
47
 
 
48
sub fds_to_bits {
 
49
        my $bits = '';
 
50
        for my $fd (@_) {
 
51
                vec($bits, $fd, 1) = 1;
 
52
        }
 
53
        return $bits;
 
54
}
 
55
 
 
56
sub wait_for_readable {
 
57
        # nfound = select rbits, wbits, ebits, timeout
 
58
        # xbits is constructed by setting the nth bit for any handle that applies,
 
59
        # where n is fileno(handle); i.e. the fd of the handle.
 
60
        my @handles = @_;
 
61
        my %map = ();
 
62
        for my $h (@handles) {
 
63
                my $fd = fileno($h);
 
64
                $map{$fd} = $h;
 
65
        }
 
66
        my $rbits = fds_to_bits(keys %map);
 
67
        my $rout = $rbits;
 
68
        select($rout, undef, undef, undef);
 
69
        -- we are here --
 
70
}
 
71
 
 
72
my $sock = get_listening_nb_socket("./example.sock");
 
73
 
 
74
say "looks good, $sock";
 
75
 
 
76
{
 
77
        my($newsock, $a) = accept_on_nb_socket($sock);
 
78
        if($newsock) {
 
79
                say "Connected - $a on $newsock";
 
80
        }
 
81
        else {
 
82
                say "Not yet";
 
83
                sleep 1;
 
84
                say "Trying again";
 
85
                redo;
 
86
        }
 
87
}