1# $OpenBSD: Client.pm,v 1.2 2021/12/12 10:56:49 bluhm Exp $ 2 3# Copyright (c) 2010-2012 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 Client; 21use parent 'Proc'; 22use Carp; 23use Socket qw(IPPROTO_TCP TCP_NODELAY); 24use Socket6; 25use IO::Socket; 26use IO::Socket::IP -register; 27 28sub new { 29 my $class = shift; 30 my %args = @_; 31 $args{logfile} ||= "client.log"; 32 $args{up} ||= "Connected"; 33 $args{down} ||= $args{alarm} ? "Alarm" : 34 "Shutdown|Broken pipe|Connection reset by peer"; 35 my $self = Proc::new($class, %args); 36 $self->{protocol} ||= "tcp"; 37 $self->{connectdomain} 38 or croak "$class connect domain not given"; 39 $self->{connectaddr} 40 or croak "$class connect addr not given"; 41 $self->{connectport} 42 or croak "$class connect port not given"; 43 44 if ($self->{bindaddr}) { 45 my $cs = IO::SocketIP->new( 46 Proto => $self->{protocol}, 47 Domain => $self->{connectdomain}, 48 LocalAddr => $self->{bindaddr}, 49 LocalPort => $self->{bindport}, 50 ) or die ref($self), " socket connect failed: $!"; 51 $self->{bindaddr} = $cs->sockhost(); 52 $self->{bindport} = $cs->sockport(); 53 $self->{cs} = $cs; 54 } 55 56 return $self; 57} 58 59sub child { 60 my $self = shift; 61 62 my $cs = $self->{cs} || IO::Socket->new( 63 Proto => $self->{protocol}, 64 Domain => $self->{connectdomain}, 65 ) or die ref($self), " socket connect failed: $!"; 66 if ($self->{oobinline}) { 67 setsockopt($cs, SOL_SOCKET, SO_OOBINLINE, pack('i', 1)) 68 or die ref($self), " set oobinline connect failed: $!"; 69 } 70 if ($self->{sndbuf}) { 71 setsockopt($cs, SOL_SOCKET, SO_SNDBUF, 72 pack('i', $self->{sndbuf})) 73 or die ref($self), " set sndbuf connect failed: $!"; 74 } 75 if ($self->{rcvbuf}) { 76 setsockopt($cs, SOL_SOCKET, SO_RCVBUF, 77 pack('i', $self->{rcvbuf})) 78 or die ref($self), " set rcvbuf connect failed: $!"; 79 } 80 if ($self->{protocol} eq "tcp") { 81 setsockopt($cs, IPPROTO_TCP, TCP_NODELAY, pack('i', 1)) 82 or die ref($self), " set nodelay connect failed: $!"; 83 } 84 my @rres = getaddrinfo($self->{connectaddr}, $self->{connectport}, 85 $self->{connectdomain}, SOCK_STREAM); 86 $cs->connect($rres[3]) 87 or die ref($self), " connect failed: $!"; 88 print STDERR "connect sock: ",$cs->sockhost()," ",$cs->sockport(),"\n"; 89 print STDERR "connect peer: ",$cs->peerhost()," ",$cs->peerport(),"\n"; 90 $self->{bindaddr} = $cs->sockhost(); 91 $self->{bindport} = $cs->sockport(); 92 if ($self->{nonblocking}) { 93 $cs->blocking(0) 94 or die ref($self), " set non-blocking connect failed: $!"; 95 } 96 97 open(STDOUT, '>&', $cs) 98 or die ref($self), " dup STDOUT failed: $!"; 99 open(STDIN, '<&', $cs) 100 or die ref($self), " dup STDIN failed: $!"; 101} 102 1031; 104