1 | #!/usr/bin/perl -w |
---|
2 | # |
---|
3 | # Test default parameters against Stanford's NetDB service. |
---|
4 | # |
---|
5 | # This test can only be run by someone local to Stanford with appropriate |
---|
6 | # access to the NetDB role server and will be skipped in all other |
---|
7 | # environments. We need to use a known service running on the standard ports |
---|
8 | # in order to test undefined values passed to Net::Remctl functions. |
---|
9 | # |
---|
10 | # Written by Russ Allbery |
---|
11 | # Copyright 2008 Board of Trustees, Leland Stanford Jr. University |
---|
12 | # |
---|
13 | # See LICENSE for licensing terms. |
---|
14 | |
---|
15 | BEGIN { our $total = 6 } |
---|
16 | use Test::More tests => $total; |
---|
17 | |
---|
18 | use Net::Remctl; |
---|
19 | |
---|
20 | my $netdb = 'netdb-node-roles-rc.stanford.edu'; |
---|
21 | my $host = 'windlord.stanford.edu'; |
---|
22 | my $user = 'rra'; |
---|
23 | |
---|
24 | # Determine the local principal. |
---|
25 | my $klist = `klist 2>&1` || ''; |
---|
26 | SKIP: { |
---|
27 | skip "tests useful only with Stanford Kerberos tickets", $total |
---|
28 | unless $klist =~ /^Default principal: \S+\@stanford\.edu$/m; |
---|
29 | my $remctl = Net::Remctl->new; |
---|
30 | isa_ok ($remctl, 'Net::Remctl', 'Object creation'); |
---|
31 | |
---|
32 | # We want to test behavior in the presence of explicitly undefined values, |
---|
33 | # so suppress the warnings. |
---|
34 | no warnings 'uninitialized'; |
---|
35 | ok ($remctl->open($netdb, undef, undef), |
---|
36 | 'Connection with explicit undef'); |
---|
37 | undef $remctl; |
---|
38 | $remctl = Net::Remctl->new; |
---|
39 | my $port = undef; |
---|
40 | my $principal = undef; |
---|
41 | ok ($remctl->open($netdb, $port, $principal), |
---|
42 | 'Connection with implicit undef'); |
---|
43 | ok ($remctl->command('netdb', 'node-roles', $user, $host), |
---|
44 | 'Sending command'); |
---|
45 | my ($output, $roles); |
---|
46 | my $okay = 1; |
---|
47 | do { |
---|
48 | $output = $remctl->output; |
---|
49 | if ($output->type eq 'output') { |
---|
50 | if ($output->stream == 1) { |
---|
51 | $roles .= $output->data; |
---|
52 | } elsif ($output->stream == 2) { |
---|
53 | print STDERR $output->data; |
---|
54 | $okay = 0; |
---|
55 | } |
---|
56 | } elsif ($output->type eq 'error') { |
---|
57 | warn $output->error, "\n"; |
---|
58 | $okay = 0; |
---|
59 | } elsif ($output->type eq 'status') { |
---|
60 | $okay = 0 unless $output->status == 0; |
---|
61 | } else { |
---|
62 | die "Unknown output token from library: ", $output->type, "\n"; |
---|
63 | } |
---|
64 | } while ($output->type eq 'output'); |
---|
65 | ok ($okay, 'Reading output'); |
---|
66 | is ($roles, "admin\nuser\n", 'Saw correct output'); |
---|
67 | } |
---|