[2edec46] | 1 | #!/usr/bin/perl |
---|
| 2 | |
---|
| 3 | package gateway_lib; |
---|
| 4 | |
---|
[2b35261] | 5 | # Package stuff to keep the caller's namespace clean, but allow additions if |
---|
| 6 | # they need it. |
---|
[2edec46] | 7 | require Exporter; |
---|
| 8 | @ISA=qw(Exporter); |
---|
| 9 | @EXPORT_OK=qw(set_sshd_params import_key wait_for_DNS deter_tunnelip |
---|
| 10 | configure_outgoing_iface add_route bind_tap_to_iface iface_to_addr |
---|
| 11 | dest_to_iface addr_to_iface); |
---|
| 12 | |
---|
| 13 | use strict; |
---|
| 14 | |
---|
| 15 | use IO::File; |
---|
| 16 | use IO::Pipe; |
---|
| 17 | |
---|
| 18 | use File::Temp; |
---|
| 19 | use File::Copy; |
---|
| 20 | |
---|
[2b35261] | 21 | # Standard locations of these commands (FreeBSD) |
---|
[2edec46] | 22 | my $IFCONFIG = "/sbin/ifconfig"; |
---|
| 23 | my $ROUTE = "/sbin/route"; |
---|
| 24 | my $TMCC = "/usr/local/etc/emulab/tmcc"; |
---|
| 25 | my $FINDIF = "/usr/local/etc/emulab/findif"; |
---|
| 26 | |
---|
[2b35261] | 27 | # Takes an ssh config file and a reference to a hash of keys whose values must |
---|
| 28 | # be set a specific way. Replaces existing entries with the set values. |
---|
[2edec46] | 29 | sub set_sshd_params { |
---|
| 30 | my($keys, $file) = @_; |
---|
| 31 | my $f; |
---|
| 32 | my $t; |
---|
| 33 | |
---|
| 34 | $file = "/etc/ssh/sshd_config" unless $file; |
---|
| 35 | $f = new IO::File("$file") || die "Can't read $f: $!\n"; |
---|
| 36 | $t = new File::Temp() || die "Can't open tempfile: $!\n"; |
---|
| 37 | |
---|
| 38 | while (<$f>) { |
---|
| 39 | foreach my $k (keys %{$keys}) { |
---|
| 40 | s/^\s*#?\s*$k.*/$k $keys->{$k}/; |
---|
| 41 | } |
---|
| 42 | print $t $_; |
---|
| 43 | } |
---|
| 44 | $f->close(); |
---|
| 45 | $t->close(); |
---|
| 46 | copy("$file", "$file.hold"); |
---|
| 47 | copy($t->filename, $file); |
---|
| 48 | # When $t goes out of scope, the tmpfile is deleted |
---|
| 49 | } |
---|
| 50 | |
---|
[2b35261] | 51 | # Append the given keyfile to the given authorised key file. |
---|
[2edec46] | 52 | sub import_key { |
---|
| 53 | my($keyfile, $authkeys) = @_; |
---|
| 54 | |
---|
| 55 | my $kf = new IO::File($keyfile) || die "Can't open $keyfile:$!\n"; |
---|
| 56 | my $ak = new IO::File(">>$authkeys") || die "Can't open $authkeys: $!\n"; |
---|
| 57 | |
---|
| 58 | while (<$kf>) { |
---|
| 59 | print $ak $_; |
---|
| 60 | } |
---|
| 61 | $kf->close(); |
---|
| 62 | $ak->close(); |
---|
| 63 | } |
---|
| 64 | |
---|
[2b35261] | 65 | # Keep trying to look up the given hostname until successful. If timeout is |
---|
| 66 | # given, die after waiting that long. If sleep is given, wait that many |
---|
| 67 | # seconds between attempts (defaults to 5). |
---|
[2edec46] | 68 | sub wait_for_DNS { |
---|
[2b35261] | 69 | my($name, $timeout, $sleep) = @_; |
---|
[2edec46] | 70 | my $start = time(); |
---|
[2b35261] | 71 | $sleep = 5 unless $sleep; |
---|
[2edec46] | 72 | my @rv; |
---|
| 73 | |
---|
| 74 | while (!@rv) { |
---|
| 75 | @rv = gethostbyname($name); |
---|
| 76 | die "Timeout waiting for DNS to get $name\n" |
---|
| 77 | if ($timeout && time() - $start > $timeout); |
---|
[2b35261] | 78 | sleep($sleep) unless @rv; |
---|
[2edec46] | 79 | } |
---|
| 80 | } |
---|
| 81 | |
---|
[2b35261] | 82 | # Get the external access parameters (interface, address, netmask, mac address, |
---|
| 83 | # and next hop router) from tmcd in Emulabs that support the DETER tunnelip |
---|
| 84 | # extension. |
---|
[2edec46] | 85 | sub deter_tunnelip { |
---|
| 86 | # To parse tmcc |
---|
| 87 | my $tmcc = new IO::Pipe || die "Can't create tmcc pipe: $!\n"; |
---|
| 88 | my $interface; # Interface with external address |
---|
| 89 | my $ip; # IP address of external interface |
---|
| 90 | my $mac; # MAC address |
---|
| 91 | my $netmask; # Netmask |
---|
| 92 | my $router; # Router for the internet |
---|
| 93 | |
---|
| 94 | |
---|
[2b35261] | 95 | # Parse out the info about tunnelips. Format is usually one line of |
---|
| 96 | # ATTR=VALUE. Multiple lines are possible. |
---|
[2edec46] | 97 | $tmcc->reader("$TMCC tunnelip"); |
---|
| 98 | while (<$tmcc>) { |
---|
| 99 | chomp; |
---|
| 100 | /TUNNELIP=([\d\.]*)/ && do { $ip = $1; }; |
---|
| 101 | /TUNNELMASK=([\d\.]*)/ && do { $netmask = $1; }; |
---|
| 102 | /TUNNELMAC=([[:xdigit:]]*)/ && do { $mac = $1; }; |
---|
| 103 | /TUNNELROUTER=([\d\.]*)/ && do { $router = $1; }; |
---|
| 104 | } |
---|
| 105 | $tmcc->close(); |
---|
| 106 | |
---|
| 107 | die "No MAC information for tunnel.\n" unless $mac; |
---|
| 108 | |
---|
| 109 | # Use the emulab findif command to get the right interface to configure |
---|
| 110 | $interface = `$FINDIF $mac`; |
---|
| 111 | chomp $interface; |
---|
| 112 | die "Can't get interface for mac address $mac: $?" if $? || !$interface; |
---|
| 113 | |
---|
| 114 | return ($interface, $ip, $netmask, $mac, $router); |
---|
| 115 | } |
---|
| 116 | |
---|
[2b35261] | 117 | |
---|
| 118 | # Configure the given interface with the given IP address and netmask. |
---|
[2edec46] | 119 | sub configure_outgoing_iface { |
---|
[2b35261] | 120 | my ($interface, $ip, $netmask) = @_; |
---|
[2edec46] | 121 | |
---|
| 122 | my @ifconfig = ($IFCONFIG, $interface, $ip); |
---|
| 123 | push(@ifconfig, 'netmask', $netmask) if $netmask; |
---|
| 124 | |
---|
| 125 | system(@ifconfig); |
---|
| 126 | die join(" ", @ifconfig) . " failed: $!\n" if $?; |
---|
| 127 | } |
---|
| 128 | |
---|
[2b35261] | 129 | # Add a route to the destination through the router. If wait is given, do not |
---|
| 130 | # attempt to add the route until DNS has the hostname in it. If timeout is |
---|
| 131 | # given, only wait that many seconds for DNS to acquire it. |
---|
[2edec46] | 132 | sub add_route { |
---|
| 133 | my($routedest, $router, $wait, $timeout) = @_; |
---|
| 134 | my @cmd; |
---|
| 135 | # Linux and FreeBSD use slightly different route syntax, so get the OS |
---|
| 136 | my $os = `uname`; |
---|
| 137 | chomp $os; |
---|
| 138 | |
---|
| 139 | $timeout = 0 unless $timeout; |
---|
| 140 | die "add_host_route needs a router and a destination\n" |
---|
| 141 | unless $router && $routedest; |
---|
| 142 | |
---|
| 143 | wait_for_DNS($routedest, $timeout) if $wait; |
---|
| 144 | |
---|
| 145 | if ( $os =~ /^Linux/ ) { |
---|
| 146 | @cmd = ($ROUTE, 'add', $routedest, 'gw', $router); |
---|
| 147 | } |
---|
| 148 | elsif ( $os =~ /^FreeBSD/ ) { |
---|
| 149 | @cmd = ($ROUTE, 'add', $routedest, $router); |
---|
| 150 | } |
---|
| 151 | else { |
---|
| 152 | die "Unknown OS: $os\n"; |
---|
| 153 | } |
---|
| 154 | system(@cmd); |
---|
| 155 | warn join(" ", @cmd) . " failed: $?\n" if $?; |
---|
| 156 | return $?; |
---|
| 157 | } |
---|
| 158 | |
---|
[2b35261] | 159 | # Connect the tap($tapno) interface to $iface at the link level. Remove any IP |
---|
| 160 | # addresses assigned to interface to avoid confusing the routing system. We're |
---|
| 161 | # very tolerant of errors as the bridge and other interfaces may already exist |
---|
| 162 | # when this is called. |
---|
[2edec46] | 163 | sub bind_tap_to_iface { |
---|
| 164 | my($tapno, $iface) = @_; |
---|
| 165 | my $bridge = "bridge$tapno"; |
---|
| 166 | my $tap = "tap$tapno"; |
---|
| 167 | my @addr = iface_to_addr($iface); |
---|
| 168 | |
---|
| 169 | # Wait for the tap |
---|
| 170 | system("$IFCONFIG $tap > /dev/null 2>/dev/null"); |
---|
| 171 | while ($?) { |
---|
| 172 | system("$IFCONFIG $tap > /dev/null 2>/dev/null"); |
---|
| 173 | } |
---|
| 174 | |
---|
| 175 | system("ifconfig $bridge create"); |
---|
| 176 | warn "Cannot create bridge: $?\n" if $?; |
---|
| 177 | foreach my $a (@addr) { |
---|
| 178 | system("ifconfig $iface delete $a"); |
---|
| 179 | warn "Cannot delete address $a: $?\n" if $?; |
---|
| 180 | } |
---|
| 181 | system("ifconfig $bridge addm $iface up"); |
---|
| 182 | warn "Cannot add intefrace $iface to bridge: $?\n" if $?; |
---|
| 183 | system("ifconfig $bridge addm $tap"); |
---|
| 184 | warn "Cannot add intefrace $tap to bridge: $?\n" if $?; |
---|
| 185 | return $?; |
---|
| 186 | } |
---|
| 187 | |
---|
[2b35261] | 188 | # Return the IP addresses accociated with this interface (as a list) |
---|
[2edec46] | 189 | sub iface_to_addr { |
---|
| 190 | my($iface) = @_; |
---|
| 191 | my $ipipe = new IO::Pipe() || die "Can't create pipe for ifconfig: $!\n"; |
---|
| 192 | my @addr; |
---|
| 193 | |
---|
| 194 | $ipipe->reader("$IFCONFIG $iface"); |
---|
| 195 | while(<$ipipe>) { |
---|
| 196 | /inet\s+([0-9\.]+)/ && push(@addr, $1); |
---|
| 197 | } |
---|
| 198 | $ipipe->close(); |
---|
| 199 | return @addr; |
---|
| 200 | } |
---|
| 201 | |
---|
[2b35261] | 202 | # Return the interface that packets to this host (IP or DNS) would be sent on. |
---|
[2edec46] | 203 | sub dest_to_iface { |
---|
| 204 | my($dest) =@_; |
---|
| 205 | my $rpipe = new IO::Pipe() || die "Can't create pipe for route: $!\n"; |
---|
| 206 | |
---|
| 207 | $rpipe->reader("$ROUTE get $dest"); |
---|
| 208 | while (<$rpipe>) { |
---|
| 209 | /interface:\s*([[:alnum:]]+)/ && do { |
---|
| 210 | my $iface = $1; |
---|
| 211 | $rpipe->close(); |
---|
| 212 | return $iface; |
---|
| 213 | }; |
---|
| 214 | } |
---|
| 215 | $rpipe->close(); |
---|
| 216 | |
---|
| 217 | die "No route to $dest\n"; |
---|
| 218 | } |
---|
| 219 | |
---|
[2b35261] | 220 | # Return the interface bound to this IP address. If there are more than one, |
---|
| 221 | # the first one returned by ifconfig is the one returned. |
---|
[2edec46] | 222 | sub addr_to_iface { |
---|
| 223 | my($addr) = @_; |
---|
| 224 | my $ipipe = new IO::Pipe() || die "Can't create pipe for ifconfig: $!\n"; |
---|
| 225 | my $iface; |
---|
| 226 | |
---|
| 227 | $ipipe->reader("$IFCONFIG"); |
---|
| 228 | while(<$ipipe>) { |
---|
| 229 | /^([[:alnum:]]+):/ && do { |
---|
| 230 | $iface = $1; |
---|
| 231 | next; |
---|
| 232 | }; |
---|
| 233 | /inet\s+([0-9\.]+)/ && do { |
---|
| 234 | if ($1 eq $addr) { |
---|
| 235 | $ipipe->close(); |
---|
| 236 | return $iface; |
---|
| 237 | } |
---|
| 238 | }; |
---|
| 239 | } |
---|
| 240 | $ipipe->close(); |
---|
| 241 | die "Cannot match $addr to an interface\n"; |
---|
| 242 | } |
---|
| 243 | |
---|
| 244 | 1; |
---|