source: fedkit/gateway_lib.pm @ 2dc99e3

Last change on this file since 2dc99e3 was 87b1a06, checked in by Ted Faber <faber@…>, 12 years ago

Some minimal changes for nat_portal

  • Property mode set to 100644
File size: 11.2 KB
Line 
1#!/usr/bin/perl
2
3package gateway_lib;
4
5# Package stuff to keep the caller's namespace clean, but allow additions if
6# they need it.
7require 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 read_config config_filename);
12
13
14use strict;
15
16use IO::File;
17use IO::Pipe;
18use IO::Socket;
19
20use File::Temp;
21use File::Copy;
22use Net::hostent;
23
24# Standard locations of these commands (FreeBSD)
25my $IFCONFIG = "/sbin/ifconfig";
26my $ROUTE = "/sbin/route";
27my $TMCC = "/usr/local/etc/emulab/tmcc";
28my $FINDIF = "/usr/local/etc/emulab/findif";
29my $TMCC = "/usr/local/etc/emulab/tmcc";
30
31# Linux choices
32my $BRCTL = "/usr/sbin/brctl";
33my $IPROUTE = "/sbin/ip route ";
34
35# Takes an ssh config file and a reference to a hash of keys whose values must
36# be set a specific way.  Replaces existing entries with the set values.
37sub set_sshd_params {
38    my($keys, $file) = @_;
39    my $f;
40    my $t;
41
42    $file = "/etc/ssh/sshd_config" unless $file;
43    $f = new IO::File("$file") || die "Can't read $f: $!\n";
44    $t = new File::Temp() || die "Can't open tempfile: $!\n";
45
46    while (<$f>) {
47        foreach my $k (keys %{$keys}) {
48            s/^\s*#?\s*$k.*/$k $keys->{$k}/;
49        }
50        print $t $_;
51    }
52    $f->close();
53    $t->close();
54    copy("$file", "$file.hold");
55    copy($t->filename, $file);
56    # When $t goes out of scope, the tmpfile is deleted
57}
58
59# Append the given keyfile to the given authorised key file.
60sub import_key {
61    my($keyfile, $authkeys) = @_;
62
63    my $kf = new IO::File($keyfile) || die "Can't open $keyfile:$!\n";
64    my $ak = new IO::File(">>$authkeys") || die "Can't open $authkeys: $!\n";
65
66    while (<$kf>) {
67        print $ak $_;
68    }
69    $kf->close();
70    $ak->close();
71}
72
73# Keep trying to look up the given hostname until successful.  If timeout is
74# given, die after waiting that long.  If sleep is given, wait that many
75# seconds between attempts (defaults to 5). 
76sub wait_for_DNS {
77    my($name, $timeout, $sleep) = @_;
78    my $start = time();
79    $sleep = 5 unless $sleep;
80    my $rv;
81
82    # If the name is an IP address, skip this.
83    return if $name =~ /^[\d\.]+$/;
84
85    while (!$rv) {
86        $rv = gethostbyname($name);
87        die "Timeout waiting for DNS to get $name\n" 
88            if ($timeout && time() - $start > $timeout);
89        sleep($sleep) unless $rv;
90    }
91}
92
93# Get the external access parameters (interface, address, netmask, mac address,
94# and next hop router) from tmcd in Emulabs that support the DETER tunnelip
95# extension.
96sub deter_tunnelip {
97    # To parse tmcc
98    my $tmcc = new IO::Pipe || die "Can't create tmcc pipe: $!\n";
99    my $interface;              # Interface with external address
100    my $ip;                     # IP address of external interface
101    my $mac;                    # MAC address
102    my $netmask;                # Netmask
103    my $router;                 # Router for the internet
104
105
106    # Parse out the info about tunnelips.  Format is usually one line of
107    # ATTR=VALUE.  Multiple lines are possible.
108    $tmcc->reader("$TMCC tunnelip");
109    while (<$tmcc>) {
110        chomp;
111        /TUNNELIP=([\d\.]*)/ && do { $ip = $1; };
112        /TUNNELMASK=([\d\.]*)/ && do { $netmask = $1; };
113        /TUNNELMAC=([[:xdigit:]]*)/ && do { $mac = $1; };
114        /TUNNELROUTER=([\d\.]*)/ && do { $router = $1; };
115    }
116    $tmcc->close();
117
118    die "No MAC information for tunnel.\n" unless $mac;
119
120    # Use the emulab findif command to get the right interface to configure
121    $interface = `$FINDIF $mac`;
122    chomp $interface;
123    die "Can't get interface for mac address $mac: $?" if $? || !$interface;
124
125    return ($interface, $ip, $netmask, $mac, $router);
126}
127
128
129# Configure the given interface with the given IP address and netmask.
130sub configure_outgoing_iface {
131    my ($interface, $ip, $netmask) = @_;
132
133    my @ifconfig = ($IFCONFIG, $interface, $ip);
134    push(@ifconfig, 'netmask', $netmask) if $netmask;
135
136    system(@ifconfig);
137    die join(" ", @ifconfig) . " failed: $!\n" if $?;
138}
139
140# Add a route to the destination through the router.  If wait is given, do not
141# attempt to add the route until DNS has the hostname in it.  If timeout is
142# given, only wait that many seconds for DNS to acquire it.
143sub add_route {
144    my($routedest, $router, $wait, $timeout) = @_;
145    my @cmd;
146    # Linux and FreeBSD use slightly different route syntax, so get the OS
147    my $os = `uname`;
148    chomp $os;
149
150    $timeout = 0 unless $timeout;
151    die "add_host_route needs a router and a destination\n"
152        unless $router && $routedest;
153
154    wait_for_DNS($routedest, $timeout) if $wait;
155
156    if ( $os =~ /^Linux/ ) { 
157        @cmd = ($ROUTE, 'add', $routedest, 'gw', $router);
158    }
159    elsif ( $os =~ /^FreeBSD/ ) {
160        @cmd = ($ROUTE, 'add', $routedest, $router);
161    }
162    else {
163        die "Unknown OS: $os\n";
164    }
165    system(@cmd);
166    warn join(" ", @cmd) . " failed: $?\n" if $?;
167    return $?;
168}
169
170# Connect the tap($tapno) interface to $iface at the link level.  Remove any IP
171# addresses assigned to interface to avoid confusing the routing system.  We're
172# very tolerant of errors as the bridge and other interfaces may already exist
173# when this is called.
174sub bind_tap_to_iface {
175    my($tapno, $iface) = @_;
176    my $bridge = "bridge$tapno";
177    my $tap = "tap$tapno";
178    my @addr = iface_to_addr($iface);
179
180    # Wait for the tap
181    system("$IFCONFIG $tap > /dev/null 2>/dev/null");
182    while ($?) {
183        system("$IFCONFIG $tap > /dev/null 2>/dev/null");
184    }
185
186    my $uname = `uname`;
187    chomp $uname;
188
189    if ($uname =~ /FreeBSD/) {
190        system("ifconfig $bridge create");
191        warn "Cannot create bridge: $?\n" if $?;
192        foreach my $a (@addr) {
193            system("ifconfig $iface delete $a");
194            warn "Cannot delete address $a: $?\n" if $?;
195        }
196        system("ifconfig $bridge addm $iface up");
197        warn "Cannot add intefrace $iface to bridge: $?\n" if $?;
198        system("ifconfig $bridge addm $tap");
199        warn "Cannot add intefrace $tap to bridge: $?\n" if $?;
200        return $?;
201    }
202    elsif ($uname =~ /Linux/) {
203        system("$IFCONFIG $iface 0.0.0.0 down");
204        system("$BRCTL addbr $bridge");
205        warn "Cannot create bridge: $?\n" if $?;
206        system("$BRCTL addif $bridge $tap");
207        system("$BRCTL addif $bridge $iface");
208        system("$BRCTL stp $bridge off");
209        system("$IFCONFIG $bridge up");
210        system("$IFCONFIG $tap up");
211        system("$IFCONFIG $iface up");
212        return $?;
213    }
214}
215
216# Return the IP addresses accociated with this interface (as a list)
217sub iface_to_addr {
218    my($iface) = @_;
219    my $ipipe = new IO::Pipe() || die "Can't create pipe for ifconfig: $!\n";
220    my @addr;
221    my $uname = `uname`;
222    my $ipre = "inet\\s+([0-9\\.]+)";
223    chomp $uname;
224
225    if ($uname =~ /Linux/) {
226        $ipre = "inet\\s+addr:\\s*([0-9\\.]+)";
227    }
228
229    $ipipe->reader("$IFCONFIG $iface");
230    while(<$ipipe>) {
231        /$ipre/ && push(@addr, $1);
232    }
233    $ipipe->close();
234    return @addr;
235}
236
237# Return the interface that packets to this host (IP or DNS) would be sent on.
238sub dest_to_iface {
239    my($dest) =@_;
240    my $rpipe = new IO::Pipe() || die "Can't create pipe for route: $!\n";
241    my $uname = `uname`;
242    chomp $uname;
243    my $route;
244    my $dev_re;
245
246    if ($uname =~ /Linux/) {
247        $route = $IPROUTE;
248        $dev_re = "\\s+dev\\s+(\\S+)";
249    }
250    elsif ($uname =~ /FreeBSD/) {
251        $route = $ROUTE;
252        $dev_re = 'interface:\\s*([[:alnum:]]+)';
253    }
254
255
256    print "$route get $dest\n";
257    $rpipe->reader("$route get $dest");
258    while (<$rpipe>) {
259        /$dev_re/ && do {
260            my $iface = $1;
261            $rpipe->close();
262            print "matched: $iface\n";
263            return $iface;
264        };
265    }
266    $rpipe->close();
267
268    die "No route to $dest\n";
269}
270
271# Return the interface bound to this IP address.  If there are more than one,
272# the first one returned by ifconfig is the one returned.
273sub addr_to_iface {
274    my($addr) = @_;
275    my $ipipe = new IO::Pipe() || die "Can't create pipe for ifconfig: $!\n";
276    my $iface;
277
278    $ipipe->reader("$IFCONFIG");
279    while(<$ipipe>) {
280        /^([[:alnum:]]+):/ && do {
281            $iface = $1;
282            next;
283        };
284        /inet\s+([0-9\.]+)/ && do {
285            if ($1 eq $addr) {
286                $ipipe->close();
287                return $iface;
288            }
289        };
290    }
291    $ipipe->close();
292    die "Cannot match $addr to an interface\n";
293}
294
295sub read_config {
296    my($file, $map) = @_;
297    my %param;
298    my %keywords;
299    my $f;
300
301    foreach my $k (keys %{$map}) {
302        if ( $k =~ /(\S+)=[si]/ ) {
303            $keywords{$1} = $map->{$k};
304            $param{$1}++;
305        }
306        else {
307            $keywords{$k} = $map->{$k};
308        }
309    }
310
311    $f = new IO::File($file) || die "Can't open $file: $!\n";
312    while (<$f>) {
313        /^\s*([^:]+):\s*(.*)/ && do {
314            my $keyw = $1;
315            my $val = $2;
316
317            $keyw =~ tr [A-Z] [a-z];
318
319            if ($keywords{$keyw} ) {
320                if ( $param{$keyw} ) { 
321                    if ( ref($keywords{$keyw}) eq 'SCALAR') {
322                        ${$keywords{$keyw}} = $val;
323                    }
324                    elsif( ref($keywords{$keyw}) eq 'ARRAY') {
325                        push(@{$keywords{$keyw}}, $val);
326                    }
327                    else {
328                        die "Unknown variable type for $keyw\n";
329                    }
330                }
331                else  { ${$keywords{$keyw}}++; }
332            }
333            next;
334        };
335    }
336    $f->close();
337}
338
339
340sub config_filename {
341    # Find the configuration file in the usual places, if there is one in
342    # /usr/local/federation/etc, use it, otherwise look in the emulab standard
343    # filesystems which depends on what experiment and project we're in.
344    my $pid;
345    my $eid;
346    my $filename;
347    my $fed_dir = "/usr/local/federation/etc/";
348    my $hn = `hostname`;
349    chomp $hn;
350    $hn =~ s/\..*//;
351
352    return "$fed_dir/$hn.gw.conf" if -r "$fed_dir/$hn.gw.conf";
353
354    my $tmcd = new IO::Pipe() || die "Can't create pipe: $!\n";
355
356    $tmcd->reader("$TMCC status");
357
358    while (<$tmcd>) {
359        chomp;
360        /ALLOCATED=([^\/]+)\/(\S+)/ && do {
361            $pid = $1;
362            $eid = $2;
363        };
364    }
365    $tmcd->close();
366    $filename = "/proj/$pid/exp/$eid/tmp/$hn.gw.conf"
367        if $pid and $eid;
368
369    return $filename;
370}
371
372
373sub client_conf_filename {
374    # Find the configuration file in the usual places, if there is one in
375    # /usr/local/federation/etc, use it, otherwise look in the emulab standard
376    # filesystems which depends on what experiment and project we're in.
377    my $pid;
378    my $eid;
379    my $filename;
380    my $fed_dir = "/usr/local/federation/etc/";
381
382    return "$fed_dir/client.conf" if -r "$fed_dir/client.conf";
383
384    my $tmcd = new IO::Pipe() || die "Can't create pipe: $!\n";
385
386    $tmcd->reader("$TMCC status");
387
388    while (<$tmcd>) {
389        chomp;
390        /ALLOCATED=([^\/]+)\/(\S+)/ && do {
391            $pid = $1;
392            $eid = $2;
393        };
394    }
395    $tmcd->close();
396    $filename = "/proj/$pid/exp/$eid/tmp/client.conf"
397        if $pid and $eid;
398
399    return $filename;
400}
401
402sub wait_for_port {
403    my($addr, $port, $timeout, $sleep) = @_;
404    my $start = time();
405    $sleep = 5 unless $sleep;
406    die "Need both address and port\n" unless $addr && $port;
407
408    my $s;
409
410    while (!$s) {
411        # We've seen some arp pollution, so be proactive about clearing the
412        # cache if we're waiting to get out.
413        system("arp -d -a");
414        if (!($s = new IO::Socket(Domain => &AF_INET, PeerAddr => $addr, 
415            PeerPort => $port))) {
416            if ($timeout and time() - $start > $timeout) {
417                return undef;
418            }
419            else { sleep($sleep); }
420        }
421    }
422    $s->close();
423    return 1;
424
425}
426
427sub testcmd_repeat {
428    my($cmd, $timeout, $sleep) = @_;
429    my $start = time();
430    $sleep = 5 unless $sleep;
431
432    while (1) {
433        system("$cmd");
434        if ($?) {
435            if ($timeout and time() - $start > $timeout) {
436                return undef;
437            }
438            else { sleep($sleep); }
439        }
440        else { return 1; }
441    }
442}
443
444sub get_ip { 
445    my($name) = @_;
446    my $gwip;
447    if ( my $hent = gethostbyname($name) ) {
448        $gwip = inet_ntoa($hent->addr_list->[0]);
449    }
450    return $gwip;
451}
452
4531;
Note: See TracBrowser for help on using the repository browser.