#!/usr/bin/perl package gateway_lib; # Package stuff to keep the caller's namespace clean, but allow additions if # they need it. require Exporter; @ISA=qw(Exporter); @EXPORT_OK=qw(set_sshd_params import_key wait_for_DNS deter_tunnelip configure_outgoing_iface add_route bind_tap_to_iface iface_to_addr dest_to_iface addr_to_iface); use strict; use IO::File; use IO::Pipe; use File::Temp; use File::Copy; # Standard locations of these commands (FreeBSD) my $IFCONFIG = "/sbin/ifconfig"; my $ROUTE = "/sbin/route"; my $TMCC = "/usr/local/etc/emulab/tmcc"; my $FINDIF = "/usr/local/etc/emulab/findif"; # Takes an ssh config file and a reference to a hash of keys whose values must # be set a specific way. Replaces existing entries with the set values. sub set_sshd_params { my($keys, $file) = @_; my $f; my $t; $file = "/etc/ssh/sshd_config" unless $file; $f = new IO::File("$file") || die "Can't read $f: $!\n"; $t = new File::Temp() || die "Can't open tempfile: $!\n"; while (<$f>) { foreach my $k (keys %{$keys}) { s/^\s*#?\s*$k.*/$k $keys->{$k}/; } print $t $_; } $f->close(); $t->close(); copy("$file", "$file.hold"); copy($t->filename, $file); # When $t goes out of scope, the tmpfile is deleted } # Append the given keyfile to the given authorised key file. sub import_key { my($keyfile, $authkeys) = @_; my $kf = new IO::File($keyfile) || die "Can't open $keyfile:$!\n"; my $ak = new IO::File(">>$authkeys") || die "Can't open $authkeys: $!\n"; while (<$kf>) { print $ak $_; } $kf->close(); $ak->close(); } # Keep trying to look up the given hostname until successful. If timeout is # given, die after waiting that long. If sleep is given, wait that many # seconds between attempts (defaults to 5). sub wait_for_DNS { my($name, $timeout, $sleep) = @_; my $start = time(); $sleep = 5 unless $sleep; my @rv; while (!@rv) { @rv = gethostbyname($name); die "Timeout waiting for DNS to get $name\n" if ($timeout && time() - $start > $timeout); sleep($sleep) unless @rv; } } # Get the external access parameters (interface, address, netmask, mac address, # and next hop router) from tmcd in Emulabs that support the DETER tunnelip # extension. sub deter_tunnelip { # To parse tmcc my $tmcc = new IO::Pipe || die "Can't create tmcc pipe: $!\n"; my $interface; # Interface with external address my $ip; # IP address of external interface my $mac; # MAC address my $netmask; # Netmask my $router; # Router for the internet # Parse out the info about tunnelips. Format is usually one line of # ATTR=VALUE. Multiple lines are possible. $tmcc->reader("$TMCC tunnelip"); while (<$tmcc>) { chomp; /TUNNELIP=([\d\.]*)/ && do { $ip = $1; }; /TUNNELMASK=([\d\.]*)/ && do { $netmask = $1; }; /TUNNELMAC=([[:xdigit:]]*)/ && do { $mac = $1; }; /TUNNELROUTER=([\d\.]*)/ && do { $router = $1; }; } $tmcc->close(); die "No MAC information for tunnel.\n" unless $mac; # Use the emulab findif command to get the right interface to configure $interface = `$FINDIF $mac`; chomp $interface; die "Can't get interface for mac address $mac: $?" if $? || !$interface; return ($interface, $ip, $netmask, $mac, $router); } # Configure the given interface with the given IP address and netmask. sub configure_outgoing_iface { my ($interface, $ip, $netmask) = @_; my @ifconfig = ($IFCONFIG, $interface, $ip); push(@ifconfig, 'netmask', $netmask) if $netmask; system(@ifconfig); die join(" ", @ifconfig) . " failed: $!\n" if $?; } # Add a route to the destination through the router. If wait is given, do not # attempt to add the route until DNS has the hostname in it. If timeout is # given, only wait that many seconds for DNS to acquire it. sub add_route { my($routedest, $router, $wait, $timeout) = @_; my @cmd; # Linux and FreeBSD use slightly different route syntax, so get the OS my $os = `uname`; chomp $os; $timeout = 0 unless $timeout; die "add_host_route needs a router and a destination\n" unless $router && $routedest; wait_for_DNS($routedest, $timeout) if $wait; if ( $os =~ /^Linux/ ) { @cmd = ($ROUTE, 'add', $routedest, 'gw', $router); } elsif ( $os =~ /^FreeBSD/ ) { @cmd = ($ROUTE, 'add', $routedest, $router); } else { die "Unknown OS: $os\n"; } system(@cmd); warn join(" ", @cmd) . " failed: $?\n" if $?; return $?; } # Connect the tap($tapno) interface to $iface at the link level. Remove any IP # addresses assigned to interface to avoid confusing the routing system. We're # very tolerant of errors as the bridge and other interfaces may already exist # when this is called. sub bind_tap_to_iface { my($tapno, $iface) = @_; my $bridge = "bridge$tapno"; my $tap = "tap$tapno"; my @addr = iface_to_addr($iface); # Wait for the tap system("$IFCONFIG $tap > /dev/null 2>/dev/null"); while ($?) { system("$IFCONFIG $tap > /dev/null 2>/dev/null"); } system("ifconfig $bridge create"); warn "Cannot create bridge: $?\n" if $?; foreach my $a (@addr) { system("ifconfig $iface delete $a"); warn "Cannot delete address $a: $?\n" if $?; } system("ifconfig $bridge addm $iface up"); warn "Cannot add intefrace $iface to bridge: $?\n" if $?; system("ifconfig $bridge addm $tap"); warn "Cannot add intefrace $tap to bridge: $?\n" if $?; return $?; } # Return the IP addresses accociated with this interface (as a list) sub iface_to_addr { my($iface) = @_; my $ipipe = new IO::Pipe() || die "Can't create pipe for ifconfig: $!\n"; my @addr; $ipipe->reader("$IFCONFIG $iface"); while(<$ipipe>) { /inet\s+([0-9\.]+)/ && push(@addr, $1); } $ipipe->close(); return @addr; } # Return the interface that packets to this host (IP or DNS) would be sent on. sub dest_to_iface { my($dest) =@_; my $rpipe = new IO::Pipe() || die "Can't create pipe for route: $!\n"; $rpipe->reader("$ROUTE get $dest"); while (<$rpipe>) { /interface:\s*([[:alnum:]]+)/ && do { my $iface = $1; $rpipe->close(); return $iface; }; } $rpipe->close(); die "No route to $dest\n"; } # Return the interface bound to this IP address. If there are more than one, # the first one returned by ifconfig is the one returned. sub addr_to_iface { my($addr) = @_; my $ipipe = new IO::Pipe() || die "Can't create pipe for ifconfig: $!\n"; my $iface; $ipipe->reader("$IFCONFIG"); while(<$ipipe>) { /^([[:alnum:]]+):/ && do { $iface = $1; next; }; /inet\s+([0-9\.]+)/ && do { if ($1 eq $addr) { $ipipe->close(); return $iface; } }; } $ipipe->close(); die "Cannot match $addr to an interface\n"; } 1;