1# $OpenBSD: Client.pm,v 1.1.1.1 2013/01/03 17:36:37 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::INET6; 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::Socket::INET6->new( 46 Proto => $self->{protocol}, 47 Domain => $self->{connectdomain}, 48 Blocking => ($self->{nonblocking} ? 0 : 1), 49 LocalAddr => $self->{bindaddr}, 50 LocalPort => $self->{bindport}, 51 ) or die ref($self), " socket connect failed: $!"; 52 $self->{bindaddr} = $cs->sockhost(); 53 $self->{bindport} = $cs->sockport(); 54 $self->{cs} = $cs; 55 } 56 57 return $self; 58} 59 60sub child { 61 my $self = shift; 62 63 my $cs = $self->{cs} || IO::Socket::INET6->new( 64 Proto => $self->{protocol}, 65 Domain => $self->{connectdomain}, 66 Blocking => ($self->{nonblocking} ? 0 : 1), 67 ) or die ref($self), " socket connect failed: $!"; 68 if ($self->{oobinline}) { 69 setsockopt($cs, SOL_SOCKET, SO_OOBINLINE, pack('i', 1)) 70 or die ref($self), " set oobinline connect failed: $!"; 71 } 72 if ($self->{sndbuf}) { 73 setsockopt($cs, SOL_SOCKET, SO_SNDBUF, 74 pack('i', $self->{sndbuf})) 75 or die ref($self), " set sndbuf connect failed: $!"; 76 } 77 if ($self->{rcvbuf}) { 78 setsockopt($cs, SOL_SOCKET, SO_RCVBUF, 79 pack('i', $self->{rcvbuf})) 80 or die ref($self), " set rcvbuf connect failed: $!"; 81 } 82 if ($self->{protocol} eq "tcp") { 83 setsockopt($cs, IPPROTO_TCP, TCP_NODELAY, pack('i', 1)) 84 or die ref($self), " set nodelay connect failed: $!"; 85 } 86 my @rres = getaddrinfo($self->{connectaddr}, $self->{connectport}, 87 $self->{connectdomain}, SOCK_STREAM); 88 $cs->connect($rres[3]) 89 or die ref($self), " connect failed: $!"; 90 print STDERR "connect sock: ",$cs->sockhost()," ",$cs->sockport(),"\n"; 91 print STDERR "connect peer: ",$cs->peerhost()," ",$cs->peerport(),"\n"; 92 $self->{bindaddr} = $cs->sockhost(); 93 $self->{bindport} = $cs->sockport(); 94 95 open(STDOUT, '>&', $cs) 96 or die ref($self), " dup STDOUT failed: $!"; 97 open(STDIN, '<&', $cs) 98 or die ref($self), " dup STDIN failed: $!"; 99} 100 1011; 102