xref: /openbsd/regress/usr.sbin/syslogd/Server.pm (revision cecf84d4) 
1#	$OpenBSD: Server.pm,v 1.6 2015/01/28 22:58:38 bluhm Exp $
2
3# Copyright (c) 2010-2015 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;
24use Socket6;
25use IO::Socket;
26use IO::Socket::INET6;
27use IO::Socket::SSL;
28
29sub new {
30	my $class = shift;
31	my %args = @_;
32	$args{ktracefile} ||= "server.ktrace";
33	$args{logfile} ||= "server.log";
34	$args{up} ||= "Accepted";
35	my $self = Proc::new($class, %args);
36	$self->{listenproto} ||= "udp";
37	defined($self->{listendomain})
38	    or croak "$class listen domain not given";
39	return $self->listen();
40}
41
42sub listen {
43	my $self = shift;
44	$SSL_ERROR = "";
45	my $iosocket = $self->{listenproto} eq "tls" ?
46	    "IO::Socket::SSL" : "IO::Socket::INET6";
47	my $proto = $self->{listenproto};
48	$proto = "tcp" if $proto eq "tls";
49	my $ls = $iosocket->new(
50	    Proto		=> $proto,
51	    ReuseAddr		=> 1,
52	    Domain		=> $self->{listendomain},
53	    $self->{listenaddr} ? (LocalAddr => $self->{listenaddr}) : (),
54	    $self->{listenport} ? (LocalPort => $self->{listenport}) : (),
55	    SSL_key_file	=> "server.key",
56	    SSL_cert_file	=> "server.crt",
57	    SSL_verify_mode	=> SSL_VERIFY_NONE,
58	    $self->{sslversion} ? (SSL_version => $self->{sslversion}) : (),
59	    $self->{sslciphers} ? (SSL_cipher_list => $self->{sslciphers}) : (),
60	) or die ref($self), " $iosocket socket listen failed: $!,$SSL_ERROR";
61	if ($self->{listenproto} ne "udp") {
62		listen($ls, 1)
63		    or die ref($self), " socket failed: $!";
64	}
65	my $log = $self->{log};
66	print $log "listen sock: ",$ls->sockhost()," ",$ls->sockport(),"\n";
67	$self->{listenaddr} = $ls->sockhost() unless $self->{listenaddr};
68	$self->{listenport} = $ls->sockport() unless $self->{listenport};
69	$self->{ls} = $ls;
70	return $self;
71}
72
73sub close {
74	my $self = shift;
75	$self->{ls}->close()
76	    or die ref($self)," ",ref($self->{ls}),
77	    " socket close failed: $!,$SSL_ERROR";
78	delete $self->{ls};
79	return $self;
80}
81
82sub run {
83	my $self = shift;
84	Proc::run($self, @_);
85	return $self->close();
86}
87
88sub child {
89	my $self = shift;
90
91	my $as = $self->{ls};
92	if ($self->{listenproto} ne "udp") {
93		$as = $self->{ls}->accept()
94		    or die ref($self)," ",ref($self->{ls}),
95		    " socket accept failed: $!,$SSL_ERROR";
96		print STDERR "accept sock: ",$as->sockhost()," ",
97		    $as->sockport(),"\n";
98		print STDERR "accept peer: ",$as->peerhost()," ",
99		    $as->peerport(),"\n";
100	}
101	if ($self->{listenproto} eq "tls") {
102		print STDERR "ssl version: ",$as->get_sslversion(),"\n";
103		print STDERR "ssl cipher: ",$as->get_cipher(),"\n";
104	}
105
106	*STDIN = *STDOUT = $self->{as} = $as;
107}
108
1091;
110