xref: /openbsd/regress/usr.sbin/syslogd/Server.pm (revision df3b6e8e) 
1#	$OpenBSD: Server.pm,v 1.12 2020/07/24 22:12:00 bluhm Exp $
2
3# Copyright (c) 2010-2020 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{ktracepid} = "ktrace" if $args{ktrace};
33	$args{ktracepid} = $ENV{KTRACE} if $ENV{KTRACE};
34	$args{ktracefile} ||= "server.ktrace";
35	$args{logfile} ||= "server.log";
36	$args{up} ||= "Accepted";
37	my $self = Proc::new($class, %args);
38	$self->{listenproto} ||= "udp";
39	defined($self->{listendomain})
40	    or croak "$class listen domain not given";
41	return $self->listen();
42}
43
44sub listen {
45	my $self = shift;
46	$SSL_ERROR = "";
47	my $iosocket = $self->{listenproto} eq "tls" ?
48	    "IO::Socket::SSL" : "IO::Socket::INET6";
49	my $proto = $self->{listenproto};
50	$proto = "tcp" if $proto eq "tls";
51	my $ls = $iosocket->new(
52	    Proto		=> $proto,
53	    ReuseAddr		=> 1,
54	    Domain		=> $self->{listendomain},
55	    $self->{listenaddr}	? (LocalAddr => $self->{listenaddr}) : (),
56	    $self->{listenport}	? (LocalPort => $self->{listenport}) : (),
57	    SSL_server          => 1,
58	    SSL_key_file	=> "server.key",
59	    SSL_cert_file	=> "server.crt",
60	    SSL_ca_file		=> ($self->{sslca} || "ca.crt"),
61	    SSL_verify_mode     => ($self->{sslca} ?
62		SSL_VERIFY_PEER : SSL_VERIFY_NONE),
63	    $self->{sslca}	? (SSL_verifycn_scheme => "none") : (),
64	    $self->{sslversion}	? (SSL_version => $self->{sslversion}) : (),
65	    $self->{sslciphers}	? (SSL_cipher_list => $self->{sslciphers}) : (),
66	) or die ref($self), " $iosocket socket failed: $!,$SSL_ERROR";
67	if ($self->{sndbuf}) {
68		setsockopt($ls, SOL_SOCKET, SO_SNDBUF,
69		    pack('i', $self->{sndbuf}))
70		    or die ref($self), " set SO_SNDBUF failed: $!";
71	}
72	if ($self->{rcvbuf}) {
73		setsockopt($ls, SOL_SOCKET, SO_RCVBUF,
74		    pack('i', $self->{rcvbuf}))
75		    or die ref($self), " set SO_RCVBUF failed: $!";
76	}
77	if ($self->{listenproto} ne "udp") {
78		listen($ls, 1)
79		    or die ref($self), " socket listen failed: $!";
80	}
81	my $log = $self->{log};
82	print $log "listen sock: ",$ls->sockhost()," ",$ls->sockport(),"\n";
83	$self->{listenaddr} = $ls->sockhost() unless $self->{listenaddr};
84	$self->{listenport} = $ls->sockport() unless $self->{listenport};
85	$self->{ls} = $ls;
86	return $self;
87}
88
89sub close {
90	my $self = shift;
91	$self->{ls}->close()
92	    or die ref($self)," ",ref($self->{ls}),
93	    " socket close failed: $!,$SSL_ERROR";
94	delete $self->{ls};
95	return $self;
96}
97
98sub run {
99	my $self = shift;
100	Proc::run($self, @_);
101	return $self->close();
102}
103
104sub child {
105	my $self = shift;
106
107	my $as = $self->{ls};
108	if ($self->{listenproto} ne "udp") {
109		$as = $self->{ls}->accept()
110		    or die ref($self)," ",ref($self->{ls}),
111		    " socket accept failed: $!,$SSL_ERROR";
112		print STDERR "accept sock: ",$as->sockhost()," ",
113		    $as->sockport(),"\n";
114		print STDERR "accept peer: ",$as->peerhost()," ",
115		    $as->peerport(),"\n";
116	}
117	if ($self->{listenproto} eq "tls") {
118		print STDERR "ssl version: ",$as->get_sslversion(),"\n";
119		print STDERR "ssl cipher: ",$as->get_cipher(),"\n";
120		print STDERR "ssl subject: ", $as->peer_certificate("subject")
121		    ,"\n" if $self->{sslca};
122	}
123
124	*STDIN = *STDOUT = $self->{as} = $as;
125}
126
1271;
128