File: circle-be

package info (click to toggle)
libcircle-be-perl 0.173320-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 388 kB
  • sloc: perl: 6,042; makefile: 2; sh: 1
file content (110 lines) | stat: -rwxr-xr-x 2,584 bytes parent folder | download | duplicates (3)
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
#!/usr/bin/perl

#  You may distribute under the terms of the GNU General Public License
#
#  (C) Paul Evans, 2008-2010 -- leonerd@leonerd.org.uk

use strict;
use warnings;

use Circle;
use IO::Async::Loop 0.37;
use IO::Async::Stream;

use Errno qw( ECONNREFUSED );
use Getopt::Long;

# Optional but handy
eval { require Devel::Confess } and Devel::Confess->import;

GetOptions(
   'p|port=i'   => \my $PORT,
   's|socket=s' => \my $SOCKPATH,
   'stdio'      => \my $STDIO,
   'C|config=s' => \my $CONFIG,
   'help' => sub { usage(0) },
) or usage(1);

sub usage
{
   my ( $exitcode ) = @_;

   print { $exitcode ? \*STDERR : \*STDOUT } <<'EOF';
circle-be [options...]

Options:

   --port, -p PORT           Listen on given TCP port

   --socket, -s SOCKET       Listen on given UNIX socket path

   --stdio                   Listen on STDIN/STDOUT

   --config, -C FILE         Override path to config file

EOF

   exit $exitcode;
}

defined($PORT) + defined($SOCKPATH) + defined($STDIO) > 1 and
   die "Cannot specify more than one of --port, --socket and --stdio\n";

defined($PORT) or defined($SOCKPATH) or defined($STDIO) or
   usage(1);

my $loop = IO::Async::Loop->new();

my $circle = Circle->new(
   loop   => $loop,
   config => $CONFIG,
);

if( defined $PORT ) {
   $circle->listen(
      addr => {
         family   => 'inet',
         socktype => 'stream',
         port     => $PORT,
         ip       => '0.0.0.0', # fscking....
      },
      on_fail => sub { print STDERR "Cannot $_[0] - $_[-1]\n"; },
      on_listen_error  => sub { print STDERR "Cannot listen\n"; },
   );
}
elsif( defined $SOCKPATH ) {
   if( -e $SOCKPATH ) {
      if( IO::Socket::UNIX->new( Peer => $SOCKPATH ) ) {
         # success - existing server running
         die "Unable to listen on $SOCKPATH - an existing server is running\n";
      }
      elsif( $! == ECONNREFUSED ) {
         # OK - no server listening
         unlink $SOCKPATH or die "Cannot unlink $SOCKPATH - $!\n";
      }
      else {
         die "Unable to probe if $SOCKPATH is in use - $!\n";
      }
   }
   $circle->listen(
      addr => {
         family   => 'unix',
         socktype => 'stream',
         path     => $SOCKPATH,
      },
      on_fail => sub { print STDERR "Cannot $_[0] - $_[-1]\n"; },
      on_listen_error => sub { print STDERR "Cannot listen\n"; },
   );
}
elsif( $STDIO ) {
   $circle->on_stream( IO::Async::Stream->new_for_stdio );
}

$SIG{__WARN__} = sub {
   local $SIG{__WARN__}; # disable during itself to avoid looping
   $circle->warn( @_ );
};

$SIG{PIPE} = "IGNORE";

$loop->run;