xref: /openbsd/regress/usr.sbin/syslogd/Client.pm (revision 5845290f)
1*5845290fSbluhm#	$OpenBSD: Client.pm,v 1.16 2021/12/22 15:14:13 bluhm Exp $
21f53c19fSbluhm
3*5845290fSbluhm# Copyright (c) 2010-2021 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 Client;
211f53c19fSbluhmuse parent 'Proc';
221f53c19fSbluhmuse Carp;
230e8195d5Sbluhmuse Socket;
240e8195d5Sbluhmuse Socket6;
250e8195d5Sbluhmuse IO::Socket;
260e8195d5Sbluhmuse IO::Socket::SSL;
271f53c19fSbluhmuse Sys::Syslog qw(:standard :extended :macros);
281f53c19fSbluhm
291f53c19fSbluhmsub new {
301f53c19fSbluhm	my $class = shift;
311f53c19fSbluhm	my %args = @_;
32df3b6e8eSbluhm	$args{ktracepid} = "ktrace" if $args{ktrace};
33df3b6e8eSbluhm	$args{ktracepid} = $ENV{KTRACE} if $ENV{KTRACE};
341f53c19fSbluhm	$args{ktracefile} ||= "client.ktrace";
351f53c19fSbluhm	$args{logfile} ||= "client.log";
361f53c19fSbluhm	$args{up} ||= "Openlog";
371f53c19fSbluhm	my $self = Proc::new($class, %args);
38be4712f2Sbluhm	if (defined($self->{connectdomain})) {
39470f2a1bSbluhm		$self->{connectproto} ||= "udp";
40be4712f2Sbluhm	}
411f53c19fSbluhm	return $self;
421f53c19fSbluhm}
431f53c19fSbluhm
441f53c19fSbluhmsub child {
451f53c19fSbluhm	my $self = shift;
461f53c19fSbluhm
4764a2a974Sbluhm	if ($self->{early}) {
4864a2a974Sbluhm		my @sudo = $ENV{SUDO} ? $ENV{SUDO} : "env";
4964a2a974Sbluhm		my @flush = (@sudo, "./logflush");
5064a2a974Sbluhm		system(@flush);
5164a2a974Sbluhm	}
5264a2a974Sbluhm
53d8bc0d06Sbluhm	# TLS 1.3 writes multiple messages without acknowledgement.
54d8bc0d06Sbluhm	# If the other side closes early, we want broken pipe error.
55eb0daeadSbluhm	$SIG{PIPE} = 'IGNORE' if defined($self->{connectdomain}) &&
56eb0daeadSbluhm	    $self->{connectproto} eq "tls";
57d8bc0d06Sbluhm
580c5e6325Sbluhm	if (defined($self->{connectdomain}) &&
590c5e6325Sbluhm	    $self->{connectdomain} ne "sendsyslog") {
60470f2a1bSbluhm		my $cs;
61470f2a1bSbluhm		if ($self->{connectdomain} == AF_UNIX) {
62470f2a1bSbluhm			$cs = IO::Socket::UNIX->new(
63470f2a1bSbluhm			    Type => SOCK_DGRAM,
64470f2a1bSbluhm			    Peer => $self->{connectpath} || "/dev/log",
65470f2a1bSbluhm			) or die ref($self), " socket unix failed: $!";
66470f2a1bSbluhm			$cs->setsockopt(SOL_SOCKET, SO_SNDBUF, 10000)
67470f2a1bSbluhm			    or die ref($self), " setsockopt failed: $!";
68470f2a1bSbluhm		} else {
690e8195d5Sbluhm			$SSL_ERROR = "";
700e8195d5Sbluhm			my $iosocket = $self->{connectproto} eq "tls" ?
71*5845290fSbluhm			    "IO::Socket::SSL" : "IO::Socket::IP";
720e8195d5Sbluhm			my $proto = $self->{connectproto};
730e8195d5Sbluhm			$proto = "tcp" if $proto eq "tls";
740e8195d5Sbluhm			$cs = $iosocket->new(
750e8195d5Sbluhm			    Proto               => $proto,
761f53c19fSbluhm			    Domain              => $self->{connectdomain},
771f53c19fSbluhm			    PeerAddr            => $self->{connectaddr},
781f53c19fSbluhm			    PeerPort            => $self->{connectport},
7915bf65a9Sbluhm			    $self->{sslcert} ?
8015bf65a9Sbluhm				(SSL_cert_file => $self->{sslcert}) : (),
8115bf65a9Sbluhm			    $self->{sslkey} ?
8215bf65a9Sbluhm				(SSL_key_file => $self->{sslkey}) : (),
8315bf65a9Sbluhm			    $self->{sslca} ?
8415bf65a9Sbluhm				(SSL_ca_file => $self->{sslca}) : (),
8515bf65a9Sbluhm			    SSL_verify_mode     => ($self->{sslca} ?
8615bf65a9Sbluhm				SSL_VERIFY_PEER : SSL_VERIFY_NONE),
870e8195d5Sbluhm			    $self->{sslversion} ?
880e8195d5Sbluhm				(SSL_version => $self->{sslversion}) : (),
890e8195d5Sbluhm			    $self->{sslciphers} ?
900e8195d5Sbluhm				(SSL_cipher_list => $self->{sslciphers}) : (),
910e8195d5Sbluhm			) or die ref($self), " $iosocket socket connect ".
920e8195d5Sbluhm			    "failed: $!,$SSL_ERROR";
9391c6fcb1Sbluhm			if ($self->{sndbuf}) {
9491c6fcb1Sbluhm				setsockopt($cs, SOL_SOCKET, SO_SNDBUF,
9591c6fcb1Sbluhm				    pack('i', $self->{sndbuf})) or die
9691c6fcb1Sbluhm				    ref($self), " set SO_SNDBUF failed: $!";
9791c6fcb1Sbluhm			}
9891c6fcb1Sbluhm			if ($self->{rcvbuf}) {
9991c6fcb1Sbluhm				setsockopt($cs, SOL_SOCKET, SO_RCVBUF,
10091c6fcb1Sbluhm				    pack('i', $self->{rcvbuf})) or die
10191c6fcb1Sbluhm				    ref($self), " set SO_RCVBUF failed: $!";
10291c6fcb1Sbluhm			}
1031f53c19fSbluhm			print STDERR "connect sock: ",$cs->sockhost()," ",
1041f53c19fSbluhm			    $cs->sockport(),"\n";
1051f53c19fSbluhm			print STDERR "connect peer: ",$cs->peerhost()," ",
1061f53c19fSbluhm			    $cs->peerport(),"\n";
1070e8195d5Sbluhm			if ($self->{connectproto} eq "tls") {
1080e8195d5Sbluhm				print STDERR "ssl version: ",
1090e8195d5Sbluhm				    $cs->get_sslversion(),"\n";
1100e8195d5Sbluhm				print STDERR "ssl cipher: ",
1110e8195d5Sbluhm				    $cs->get_cipher(),"\n";
1129a463d84Sbluhm				print STDERR "ssl issuer: ",
1139a463d84Sbluhm				    $cs->peer_certificate('issuer'),"\n";
1149a463d84Sbluhm				print STDERR "ssl subject: ",
1159a463d84Sbluhm				    $cs->peer_certificate('subject'),"\n";
1169a463d84Sbluhm				print STDERR "ssl cn: ",
1179a463d84Sbluhm				    $cs->peer_certificate('cn'),"\n";
1180e8195d5Sbluhm			}
119470f2a1bSbluhm		}
1201f53c19fSbluhm
1210e24320bSbluhm		IO::Handle::flush(\*STDOUT);
1221f53c19fSbluhm		*STDIN = *STDOUT = $self->{cs} = $cs;
1230e24320bSbluhm		select(STDOUT);
1241f53c19fSbluhm	}
1251f53c19fSbluhm
1261f53c19fSbluhm	if ($self->{logsock}) {
1271f53c19fSbluhm		setlogsock($self->{logsock})
1281f53c19fSbluhm		    or die ref($self), " setlogsock failed: $!";
1291f53c19fSbluhm	}
1301f53c19fSbluhm	# we take LOG_UUCP as it is not used nowadays
1319f048da9Sbluhm	openlog("syslogd-regress", "perror,pid", LOG_UUCP);
1321f53c19fSbluhm}
1331f53c19fSbluhm
1341f53c19fSbluhm1;
135