1*e7c2632aSbluhm# $OpenBSD: Client.pm,v 1.3 2021/12/22 15:54:01 bluhm Exp $ 253d930aeSreyk 3*e7c2632aSbluhm# Copyright (c) 2010-2021 Alexander Bluhm <bluhm@openbsd.org> 453d930aeSreyk# Copyright (c) 2015 Reyk Floeter <reyk@openbsd.org> 553d930aeSreyk# 653d930aeSreyk# Permission to use, copy, modify, and distribute this software for any 753d930aeSreyk# purpose with or without fee is hereby granted, provided that the above 853d930aeSreyk# copyright notice and this permission notice appear in all copies. 953d930aeSreyk# 1053d930aeSreyk# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 1153d930aeSreyk# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 1253d930aeSreyk# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 1353d930aeSreyk# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 1453d930aeSreyk# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 1553d930aeSreyk# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 1653d930aeSreyk# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 1753d930aeSreyk 1853d930aeSreykuse strict; 1953d930aeSreykuse warnings; 2053d930aeSreyk 2153d930aeSreykpackage Client; 2253d930aeSreykuse parent 'Proc'; 2353d930aeSreykuse Carp; 2453d930aeSreykuse Socket; 2553d930aeSreykuse Socket6; 2653d930aeSreykuse IO::Socket; 2753d930aeSreykuse IO::Socket::SSL; 2853d930aeSreyk 2953d930aeSreyksub new { 3053d930aeSreyk my $class = shift; 3153d930aeSreyk my %args = @_; 3253d930aeSreyk $args{chroot} ||= "."; 3353d930aeSreyk $args{logfile} ||= $args{chroot}."/client.log"; 3453d930aeSreyk $args{up} ||= "Connected"; 3553d930aeSreyk $args{timefile} //= "time.log"; 3653d930aeSreyk my $self = Proc::new($class, %args); 3753d930aeSreyk $self->{connectdomain} 3853d930aeSreyk or croak "$class connect domain not given"; 3953d930aeSreyk $self->{connectaddr} 4053d930aeSreyk or croak "$class connect addr not given"; 4153d930aeSreyk $self->{connectport} 4253d930aeSreyk or croak "$class connect port not given"; 4353d930aeSreyk return $self; 4453d930aeSreyk} 4553d930aeSreyk 4653d930aeSreyksub child { 4753d930aeSreyk my $self = shift; 4853d930aeSreyk 4953d930aeSreyk # in case we redo the connect, shutdown the old one 5053d930aeSreyk shutdown(\*STDOUT, SHUT_WR); 5153d930aeSreyk delete $self->{cs}; 5253d930aeSreyk 5353d930aeSreyk $SSL_ERROR = ""; 54*e7c2632aSbluhm my $iosocket = $self->{tls} ? "IO::Socket::SSL" : "IO::Socket::IP"; 5553d930aeSreyk my $cs = $iosocket->new( 5653d930aeSreyk Proto => "tcp", 5753d930aeSreyk Domain => $self->{connectdomain}, 5853d930aeSreyk PeerAddr => $self->{connectaddr}, 5953d930aeSreyk PeerPort => $self->{connectport}, 6053d930aeSreyk SSL_verify_mode => SSL_VERIFY_NONE, 61d81bb6a6Sjsing SSL_use_cert => $self->{offertlscert} ? 1 : 0, 62d81bb6a6Sjsing SSL_cert_file => $self->{offertlscert} ? 63d81bb6a6Sjsing $self->{chroot}."/client.crt" : "", 64d81bb6a6Sjsing SSL_key_file => $self->{offertlscert} ? 65d81bb6a6Sjsing $self->{chroot}."/client.key" : "", 6653d930aeSreyk ) or die ref($self), " $iosocket socket connect failed: $!,$SSL_ERROR"; 6753d930aeSreyk print STDERR "connect sock: ",$cs->sockhost()," ",$cs->sockport(),"\n"; 6853d930aeSreyk print STDERR "connect peer: ",$cs->peerhost()," ",$cs->peerport(),"\n"; 6953d930aeSreyk if ($self->{tls}) { 7053d930aeSreyk print STDERR "tls version: ",$cs->get_sslversion(),"\n"; 7153d930aeSreyk print STDERR "tls cipher: ",$cs->get_cipher(),"\n"; 7253d930aeSreyk print STDERR "tls peer certificate:\n", 7353d930aeSreyk $cs->dump_peer_certificate(); 7453d930aeSreyk } 7553d930aeSreyk 7653d930aeSreyk *STDIN = *STDOUT = $self->{cs} = $cs; 7753d930aeSreyk} 7853d930aeSreyk 7953d930aeSreyk1; 80