1# $OpenBSD: Client.pm,v 1.3 2013/06/05 04:34:27 bluhm Exp $ 2 3# Copyright (c) 2010-2013 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::INET6; 27use constant SO_BINDANY => 0x1000; 28 29sub new { 30 my $class = shift; 31 my %args = @_; 32 $args{logfile} ||= "client.log"; 33 $args{up} ||= "Connected"; 34 $args{down} ||= $args{alarm} ? "Alarm" : 35 "Shutdown|Broken pipe|Connection reset by peer"; 36 my $self = Proc::new($class, %args); 37 $self->{domain} 38 or croak "$class domain not given"; 39 $self->{protocol} 40 or croak "$class protocol not given"; 41 $self->{connectaddr} 42 or croak "$class connect addr not given"; 43 $self->{connectport} || $self->{protocol} !~ /^(tcp|udp)$/ 44 or croak "$class connect port not given"; 45 46 my $cs; 47 if ($self->{bindany}) { 48 do { local $> = 0; $cs = IO::Socket::INET6->new( 49 Type => $self->{socktype}, 50 Proto => $self->{protocol}, 51 Domain => $self->{domain}, 52 Blocking => ($self->{nonblocking} ? 0 : 1), 53 ) } or die ref($self), " socket connect failed: $!"; 54 do { local $> = 0; $cs->setsockopt(SOL_SOCKET, SO_BINDANY, 1) } 55 or die ref($self), " setsockopt SO_BINDANY failed: $!"; 56 my @rres = getaddrinfo($self->{bindaddr}, $self->{bindport}||0, 57 $self->{domain}, SOCK_STREAM, 0, AI_PASSIVE); 58 $cs->bind($rres[3]) 59 or die ref($self), " bind failed: $!"; 60 } elsif ($self->{bindaddr} || $self->{bindport}) { 61 do { local $> = 0; $cs = IO::Socket::INET6->new( 62 Type => $self->{socktype}, 63 Proto => $self->{protocol}, 64 Domain => $self->{domain}, 65 Blocking => ($self->{nonblocking} ? 0 : 1), 66 LocalAddr => $self->{bindaddr}, 67 LocalPort => $self->{bindport}, 68 ) } or die ref($self), " socket connect failed: $!"; 69 } 70 if ($cs) { 71 $self->{bindaddr} = $cs->sockhost(); 72 $self->{bindport} = $cs->sockport(); 73 $self->{cs} = $cs; 74 } 75 76 return $self; 77} 78 79sub child { 80 my $self = shift; 81 82 my $cs = $self->{cs} || do { local $> = 0; IO::Socket::INET6->new( 83 Type => $self->{socktype}, 84 Proto => $self->{protocol}, 85 Domain => $self->{domain}, 86 Blocking => ($self->{nonblocking} ? 0 : 1), 87 ) } or die ref($self), " socket connect failed: $!"; 88 if ($self->{oobinline}) { 89 setsockopt($cs, SOL_SOCKET, SO_OOBINLINE, pack('i', 1)) 90 or die ref($self), " set oobinline connect failed: $!"; 91 } 92 if ($self->{sndbuf}) { 93 setsockopt($cs, SOL_SOCKET, SO_SNDBUF, 94 pack('i', $self->{sndbuf})) 95 or die ref($self), " set sndbuf connect failed: $!"; 96 } 97 if ($self->{rcvbuf}) { 98 setsockopt($cs, SOL_SOCKET, SO_RCVBUF, 99 pack('i', $self->{rcvbuf})) 100 or die ref($self), " set rcvbuf connect failed: $!"; 101 } 102 if ($self->{protocol} eq "tcp") { 103 setsockopt($cs, IPPROTO_TCP, TCP_NODELAY, pack('i', 1)) 104 or die ref($self), " set nodelay connect failed: $!"; 105 } 106 my @rres = getaddrinfo($self->{connectaddr}, $self->{connectport}, 107 $self->{domain}, SOCK_STREAM); 108 $cs->connect($rres[3]) 109 or die ref($self), " connect failed: $!"; 110 print STDERR "connect sock: ",$cs->sockhost()," ",$cs->sockport(),"\n"; 111 print STDERR "connect peer: ",$cs->peerhost()," ",$cs->peerport(),"\n"; 112 $self->{bindaddr} = $cs->sockhost(); 113 $self->{bindport} = $cs->sockport(); 114 115 open(STDOUT, '>&', $cs) 116 or die ref($self), " dup STDOUT failed: $!"; 117 open(STDIN, '<&', $cs) 118 or die ref($self), " dup STDIN failed: $!"; 119} 120 1211; 122