1# $OpenBSD: Server.pm,v 1.2 2021/12/12 10:56:49 bluhm Exp $ 2 3# Copyright (c) 2010 Alexander Bluhm <bluhm@openbsd.org> 4# 5# Permission to use, copy, modify, and distribute this software for any 6# purpose with or without fee is hereby granted, provided that the above 7# copyright notice and this permission notice appear in all copies. 8# 9# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 17use strict; 18use warnings; 19 20package Server; 21use parent 'Proc'; 22use Carp; 23use Socket qw(IPPROTO_TCP TCP_NODELAY); 24use Socket6; 25use IO::Socket; 26use IO::Socket::IP -register; 27 28sub new { 29 my $class = shift; 30 my %args = @_; 31 $args{logfile} ||= "server.log"; 32 $args{up} ||= "Accepted"; 33 my $self = Proc::new($class, %args); 34 $self->{protocol} ||= "tcp"; 35 $self->{listendomain} 36 or croak "$class listen domain not given"; 37 my $ls = IO::Socket->new( 38 Proto => $self->{protocol}, 39 ReuseAddr => 1, 40 Domain => $self->{listendomain}, 41 $self->{listenaddr} ? (LocalAddr => $self->{listenaddr}) : (), 42 $self->{listenport} ? (LocalPort => $self->{listenport}) : (), 43 ) or die ref($self), " socket failed: $!"; 44 if ($self->{oobinline}) { 45 setsockopt($ls, SOL_SOCKET, SO_OOBINLINE, pack('i', 1)) 46 or die ref($self), " set oobinline listen failed: $!"; 47 } 48 if ($self->{sndbuf}) { 49 setsockopt($ls, SOL_SOCKET, SO_SNDBUF, 50 pack('i', $self->{sndbuf})) 51 or die ref($self), " set sndbuf listen failed: $!"; 52 } 53 if ($self->{rcvbuf}) { 54 setsockopt($ls, SOL_SOCKET, SO_RCVBUF, 55 pack('i', $self->{rcvbuf})) 56 or die ref($self), " set rcvbuf listen failed: $!"; 57 } 58 if ($self->{protocol} eq "tcp") { 59 setsockopt($ls, IPPROTO_TCP, TCP_NODELAY, pack('i', 1)) 60 or die ref($self), " set nodelay listen failed: $!"; 61 listen($ls, 1) 62 or die ref($self), " socket failed: $!"; 63 } 64 my $log = $self->{log}; 65 print $log "listen sock: ",$ls->sockhost()," ",$ls->sockport(),"\n"; 66 $self->{listenaddr} = $ls->sockhost() unless $self->{listenaddr}; 67 $self->{listenport} = $ls->sockport() unless $self->{listenport}; 68 $self->{ls} = $ls; 69 return $self; 70} 71 72sub child { 73 my $self = shift; 74 75 my $as = $self->{ls}; 76 if ($self->{protocol} eq "tcp") { 77 $as = $self->{ls}->accept() 78 or die ref($self), " socket accept failed: $!"; 79 print STDERR "accept sock: ",$as->sockhost()," ", 80 $as->sockport(),"\n"; 81 print STDERR "accept peer: ",$as->peerhost()," ", 82 $as->peerport(),"\n"; 83 } 84 if ($self->{nonblocking}) { 85 $as->blocking(0) 86 or die ref($self), " set non-blocking accept failed: $!"; 87 } 88 89 open(STDIN, '<&', $as) 90 or die ref($self), " dup STDIN failed: $!"; 91 open(STDOUT, '>&', $as) 92 or die ref($self), " dup STDOUT failed: $!"; 93} 94 951; 96