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