1# $OpenBSD: Relay.pm,v 1.4 2021/12/14 12:37:49 bluhm Exp $ 2 3# Copyright (c) 2010-2017 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 Relay; 21use parent 'Proc'; 22use Carp; 23use Errno 'EINPROGRESS'; 24use Socket qw(IPPROTO_TCP TCP_NODELAY); 25use Socket6; 26use IO::Socket; 27use IO::Socket::IP -register; 28 29sub new { 30 my $class = shift; 31 my %args = @_; 32 $args{logfile} ||= "relay.log"; 33 $args{up} ||= "Connected"; 34 $args{forward} 35 or croak "$class forward not given"; 36 my $self = Proc::new($class, %args); 37 $self->{protocol} ||= "tcp"; 38 $self->{listendomain} 39 or croak "$class listen domain not given"; 40 $self->{connectdomain} 41 or croak "$class connect domain not given"; 42 $self->{connectaddr} 43 or croak "$class connect addr not given"; 44 $self->{connectport} 45 or croak "$class connect port not given"; 46 my $ls = IO::Socket->new( 47 Proto => $self->{protocol}, 48 ReuseAddr => 1, 49 Domain => $self->{listendomain}, 50 $self->{listenaddr} ? (LocalAddr => $self->{listenaddr}) : (), 51 $self->{listenport} ? (LocalPort => $self->{listenport}) : (), 52 ) or die ref($self), " socket failed: $!"; 53 if ($self->{oobinline}) { 54 setsockopt($ls, SOL_SOCKET, SO_OOBINLINE, pack('i', 1)) 55 or die ref($self), " set oobinline listen failed: $!"; 56 } 57 if ($self->{sndbuf}) { 58 setsockopt($ls, SOL_SOCKET, SO_SNDBUF, 59 pack('i', $self->{sndbuf})) 60 or die ref($self), " set sndbuf listen failed: $!"; 61 } 62 if ($self->{rcvbuf}) { 63 setsockopt($ls, SOL_SOCKET, SO_RCVBUF, 64 pack('i', $self->{rcvbuf})) 65 or die ref($self), " set rcvbuf listen failed: $!"; 66 } 67 if ($self->{protocol} eq "tcp") { 68 setsockopt($ls, IPPROTO_TCP, TCP_NODELAY, pack('i', 1)) 69 or die ref($self), " set nodelay listen failed: $!"; 70 listen($ls, 1) 71 or die ref($self), " listen failed: $!"; 72 } 73 my $log = $self->{log}; 74 print $log "listen sock: ",$ls->sockhost()," ",$ls->sockport(),"\n"; 75 $self->{listenaddr} = $ls->sockhost() unless $self->{listenaddr}; 76 $self->{listenport} = $ls->sockport() unless $self->{listenport}; 77 $self->{ls} = $ls; 78 return $self; 79} 80 81sub child { 82 my $self = shift; 83 84 my $as = $self->{ls}; 85 if ($self->{protocol} eq "tcp") { 86 $as = $self->{ls}->accept() 87 or die ref($self), " socket accept failed: $!"; 88 print STDERR "accept sock: ",$as->sockhost()," ", 89 $as->sockport(),"\n"; 90 print STDERR "accept peer: ",$as->peerhost()," ", 91 $as->peerport(),"\n"; 92 } 93 if ($self->{nonblocking}) { 94 $as->blocking(0) 95 or die ref($self), " set non-blocking accept failed: $!"; 96 } 97 98 open(STDIN, '<&', $as) 99 or die ref($self), " dup STDIN failed: $!"; 100 print STDERR "Accepted\n"; 101 102 if ($self->{clientreadable}) { 103 my $idle = 15; # timeout 104 my $rin = ''; 105 vec($rin, fileno($as), 1) = 1; 106 defined(my $n = select($rin, undef, undef, $idle)) 107 or die ref($self), " select failed: $!"; 108 $idle && $n == 0 109 and die ref($self), " select timeout"; 110 } 111 112 my $cs = IO::Socket->new( 113 Proto => $self->{protocol}, 114 Domain => $self->{connectdomain}, 115 ) or die ref($self), " socket connect failed: $!"; 116 if ($self->{oobinline}) { 117 setsockopt($cs, SOL_SOCKET, SO_OOBINLINE, pack('i', 1)) 118 or die ref($self), " set oobinline connect failed: $!"; 119 } 120 if ($self->{sndbuf}) { 121 setsockopt($cs, SOL_SOCKET, SO_SNDBUF, 122 pack('i', $self->{sndbuf})) 123 or die ref($self), " set sndbuf connect failed: $!"; 124 } 125 if ($self->{rcvbuf}) { 126 setsockopt($cs, SOL_SOCKET, SO_RCVBUF, 127 pack('i', $self->{rcvbuf})) 128 or die ref($self), " set rcvbuf connect failed: $!"; 129 } 130 if ($self->{protocol} eq "tcp") { 131 setsockopt($cs, IPPROTO_TCP, TCP_NODELAY, pack('i', 1)) 132 or die ref($self), " set nodelay connect failed: $!"; 133 } 134 if ($self->{connectnonblocking}) { 135 $cs->blocking(0) 136 or die ref($self), " set non-blocking connect failed: $!"; 137 } 138 my @rres = getaddrinfo($self->{connectaddr}, $self->{connectport}, 139 $self->{connectdomain}, SOCK_STREAM); 140 $cs->connect($rres[3]) || $!{EINPROGRESS} 141 or die ref($self), " connect failed: $!"; 142 print STDERR "connect sock: ",$cs->sockhost()," ",$cs->sockport(),"\n"; 143 print STDERR "connect peer: ",$cs->peerhost()," ",$cs->peerport(),"\n"; 144 $self->{bindaddr} = $cs->sockhost(); 145 $self->{bindport} = $cs->sockport(); 146 if ($self->{nonblocking}) { 147 $cs->blocking(0) 148 or die ref($self), " set non-blocking connect failed: $!"; 149 } 150 151 open(STDOUT, '>&', $cs) 152 or die ref($self), " dup STDOUT failed: $!"; 153} 154 1551; 156