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