interswitch.in 2.68 KB
Newer Older
Robert Ricci's avatar
Robert Ricci committed
1
#!/usr/bin/perl
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2
3
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2000-2007 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5
6
# All rights reserved.
#
7
8
9
10
11
12
13
use strict;
use English;

#
# Turn off line buffering on output
#
$| = 1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
14

Robert Ricci's avatar
Robert Ricci committed
15
#
16
17
18
# Set umask for start/swap. We want other members in the project to be
# able to swap/end experiments, so the log and intermediate files need
# to be 664 since some are opened for append.
Robert Ricci's avatar
Robert Ricci committed
19
#
20
21
22
23
24
25
26
27
28
29
umask(0002);

#
# Untaint the path
#
# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

# Testbed Libraries.
Robert Ricci's avatar
Robert Ricci committed
30
31
use lib '@prefix@/lib';
use libdb;
32
33
use User;
use Lan;
34

35
36
37
38
39
40
41
42
43
#
# Verify user and get his DB uid and other info for later.
#
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    die("*** $0:\n".
	"    You ($UID) do not exist!\n");
}
if (!$this_user->IsAdmin()) {
44
45
46
47
    die("*** $0:\n".
	"    You must be a TB administrator to use this program\n");
}

48
my ($pid,$eid,$virtual,$id,$pideid,$members);
49
50
51
52
53
54
55
56
57
58
59
60
print << "END";
ID     Project/Experiment Link/LAN   Switches (number of members in parens)
--------------------------------------------------------------------------------
END
format vlanlist =
@<<<<< @<<<<<<<<<<<<<<<<< @<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$id,   $pideid,           $virtual,  $members
~~                                   ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                                     $members
.
$FORMAT_NAME = 'vlanlist';

Robert Ricci's avatar
Robert Ricci committed
61
62
63
64

#
# Get a list of all VLANs for swapped-in experiments
#
65
66
67
68
69
my @vlans;
if (VLan->AllVLans(\@vlans) != 0) {
    die("*** $0:\n".
	"    Unable to load VLANs for all experiments\n");
}
Robert Ricci's avatar
Robert Ricci committed
70

71
foreach my $vlan (@vlans) {
Robert Ricci's avatar
Robert Ricci committed
72
    my %switches = ();
73
74
75
76
77
78
79
80
81
82
83
    my @members;
    my $pid = $vlan->pid();
    my $eid = $vlan->eid();

    $id = $vlan->lanid();
    $virtual = $vlan->vname();

    if ($vlan->MemberList(\@members) != 0) {
	die("*** $0:\n".
	    "    Unable to load members for $vlan\n");
    }
Robert Ricci's avatar
Robert Ricci committed
84
    foreach my $member (@members) {
85
86
87
88
89
90
91
92
	my $node;
	my $iface;

	if ($member->GetNodeIface(\$node, \$iface) != 0) {
	    die("*** $0:\n".
		"    Missing attributes for $member in $vlan\n");
	}
	my $nodeid = $node->node_id();
Robert Ricci's avatar
Robert Ricci committed
93
94
95
96

	#
	# Find out which switch this interface is connected to
	#
97
98
99
100
101
	my $result2 =
	    DBQueryFatal("select node_id2 from wires as w ".
			 "left join interfaces as i on ".
			 "     w.node_id1=i.node_id AND w.card1=i.card " .
			 "where node_id='$nodeid' and iface='$iface'");
Robert Ricci's avatar
Robert Ricci committed
102
	# We assume only one response here!
103
	my ($switch) = $result2->fetchrow_array();
Robert Ricci's avatar
Robert Ricci committed
104
105
106
107
108
109
	$switches{$switch}++;
    }

    #
    # Report if more than one switch was found
    #
110
    if (scalar(keys(%switches)) > 1) {
111
112
113
	$pideid = "$pid/$eid";
	$members = join(" ", map { "$_ ($switches{$_})" } sort keys %switches);
	write;
Robert Ricci's avatar
Robert Ricci committed
114
115
    }
}