xref: /openbsd/regress/usr.sbin/syslogd/Server.pm (revision 73e391cd)
1*73e391cdSbluhm#	$OpenBSD: Server.pm,v 1.2 2014/08/25 17:55:27 bluhm Exp $
21f53c19fSbluhm
31f53c19fSbluhm# Copyright (c) 2010-2014 Alexander Bluhm <bluhm@openbsd.org>
41f53c19fSbluhm#
51f53c19fSbluhm# Permission to use, copy, modify, and distribute this software for any
61f53c19fSbluhm# purpose with or without fee is hereby granted, provided that the above
71f53c19fSbluhm# copyright notice and this permission notice appear in all copies.
81f53c19fSbluhm#
91f53c19fSbluhm# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
101f53c19fSbluhm# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
111f53c19fSbluhm# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
121f53c19fSbluhm# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
131f53c19fSbluhm# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
141f53c19fSbluhm# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
151f53c19fSbluhm# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
161f53c19fSbluhm
171f53c19fSbluhmuse strict;
181f53c19fSbluhmuse warnings;
191f53c19fSbluhm
201f53c19fSbluhmpackage Server;
211f53c19fSbluhmuse parent 'Proc';
221f53c19fSbluhmuse Carp;
231f53c19fSbluhmuse Socket;
241f53c19fSbluhmuse Socket6;
251f53c19fSbluhmuse IO::Socket;
261f53c19fSbluhmuse IO::Socket::INET6;
271f53c19fSbluhmuse IO::Socket::SSL;
281f53c19fSbluhm
291f53c19fSbluhmsub new {
301f53c19fSbluhm	my $class = shift;
311f53c19fSbluhm	my %args = @_;
321f53c19fSbluhm	$args{ktracefile} ||= "server.ktrace";
331f53c19fSbluhm	$args{logfile} ||= "server.log";
341f53c19fSbluhm	$args{up} ||= "Accepted";
351f53c19fSbluhm	my $self = Proc::new($class, %args);
361f53c19fSbluhm	$self->{listenprotocol} ||= "udp";
37*73e391cdSbluhm	defined($self->{listendomain})
381f53c19fSbluhm	    or croak "$class listen domain not given";
391f53c19fSbluhm	$SSL_ERROR = "";
401f53c19fSbluhm	my $iosocket = $self->{listenprotocol} eq "tls" ?
411f53c19fSbluhm	    "IO::Socket::SSL" : "IO::Socket::INET6";
421f53c19fSbluhm	my $proto = $self->{listenprotocol};
431f53c19fSbluhm	$proto = "tcp" if $proto eq "tls";
441f53c19fSbluhm	my $ls = $iosocket->new(
451f53c19fSbluhm	    Proto		=> $proto,
461f53c19fSbluhm	    ReuseAddr		=> 1,
471f53c19fSbluhm	    Domain		=> $self->{listendomain},
481f53c19fSbluhm	    $self->{listenaddr} ? (LocalAddr => $self->{listenaddr}) : (),
491f53c19fSbluhm	    $self->{listenport} ? (LocalPort => $self->{listenport}) : (),
501f53c19fSbluhm	    SSL_key_file	=> "server-key.pem",
511f53c19fSbluhm	    SSL_cert_file	=> "server-cert.pem",
521f53c19fSbluhm	    SSL_verify_mode	=> SSL_VERIFY_NONE,
531f53c19fSbluhm	) or die ref($self), " $iosocket socket listen failed: $!,$SSL_ERROR";
541f53c19fSbluhm	if ($self->{listenprotocol} eq "tcp") {
551f53c19fSbluhm		listen($ls, 1)
561f53c19fSbluhm		    or die ref($self), " socket failed: $!";
571f53c19fSbluhm	}
581f53c19fSbluhm	my $log = $self->{log};
591f53c19fSbluhm	print $log "listen sock: ",$ls->sockhost()," ",$ls->sockport(),"\n";
601f53c19fSbluhm	$self->{listenaddr} = $ls->sockhost() unless $self->{listenaddr};
611f53c19fSbluhm	$self->{listenport} = $ls->sockport() unless $self->{listenport};
621f53c19fSbluhm	$self->{ls} = $ls;
631f53c19fSbluhm	return $self;
641f53c19fSbluhm}
651f53c19fSbluhm
661f53c19fSbluhmsub child {
671f53c19fSbluhm	my $self = shift;
681f53c19fSbluhm
691f53c19fSbluhm	my $iosocket = $self->{ssl} ? "IO::Socket::SSL" : "IO::Socket::INET6";
701f53c19fSbluhm	my $as = $self->{ls};
711f53c19fSbluhm	if ($self->{listenprotocol} ne "udp") {
721f53c19fSbluhm		$as = $self->{ls}->accept()
731f53c19fSbluhm		    or die ref($self), " $iosocket socket accept failed: $!";
741f53c19fSbluhm		print STDERR "accept sock: ",$as->sockhost()," ",
751f53c19fSbluhm		    $as->sockport(),"\n";
761f53c19fSbluhm		print STDERR "accept peer: ",$as->peerhost()," ",
771f53c19fSbluhm		    $as->peerport(),"\n";
781f53c19fSbluhm	}
791f53c19fSbluhm
801f53c19fSbluhm	*STDIN = *STDOUT = $self->{as} = $as;
811f53c19fSbluhm}
821f53c19fSbluhm
831f53c19fSbluhm1;
84