1 | #!/usr/bin/perl -w |
---|
2 | # |
---|
3 | # Tests for the Net::Remctl API. This relies on being run as part of the |
---|
4 | # larger remctl build tree and uses the built remctld for testing. |
---|
5 | # |
---|
6 | # Written by Russ Allbery <rra@stanford.edu> |
---|
7 | # Copyright 2007, 2008, 2009 |
---|
8 | # Board of Trustees, Leland Stanford Jr. University |
---|
9 | # |
---|
10 | # See LICENSE for licensing terms. |
---|
11 | |
---|
12 | BEGIN { our $total = 30 } |
---|
13 | use Test::More tests => $total; |
---|
14 | |
---|
15 | use Net::Remctl; |
---|
16 | |
---|
17 | # Returns the principal to use for authentication. |
---|
18 | sub get_principal { |
---|
19 | open (PRINC, 'data/test.principal') or return; |
---|
20 | my $princ = <PRINC>; |
---|
21 | close PRINC; |
---|
22 | chomp $princ; |
---|
23 | return $princ; |
---|
24 | } |
---|
25 | |
---|
26 | # Do the bizarre dance to start a test version of remctld. |
---|
27 | sub start_remctld { |
---|
28 | unlink ('data/pid'); |
---|
29 | my $princ = get_principal; |
---|
30 | my $pid = fork; |
---|
31 | if (not defined $pid) { |
---|
32 | die "cannot fork: $!\n"; |
---|
33 | } elsif ($pid == 0) { |
---|
34 | chdir ('@abs_top_srcdir@/tests') |
---|
35 | or die "can't chdir to @abs_top_srcdir@: $!\n"; |
---|
36 | exec ('@abs_top_builddir@/server/remctld', '-m', '-p', '14373', |
---|
37 | (defined ($princ) ? ('-s', $princ) : ()), |
---|
38 | '-P', '@abs_top_builddir@/tests/data/pid', |
---|
39 | '-f', 'data/conf-simple', |
---|
40 | '-d', '-S', '-F', '-k', |
---|
41 | '@abs_top_builddir@/tests/data/test.keytab') |
---|
42 | or die "cannot exec @abs_top_builddir@/server/remctld: $!\n"; |
---|
43 | } |
---|
44 | } |
---|
45 | |
---|
46 | # Stop the running test remctld. |
---|
47 | sub stop_remctld { |
---|
48 | if (open (PID, 'data/pid')) { |
---|
49 | my $pid = <PID>; |
---|
50 | chomp $pid; |
---|
51 | kill (15, $pid); |
---|
52 | unlink ('data/pid'); |
---|
53 | } |
---|
54 | } |
---|
55 | |
---|
56 | # Obtain tickets, which requires iterating through several different possible |
---|
57 | # ways of running kinit. |
---|
58 | sub run_kinit { |
---|
59 | $ENV{KRB5CCNAME} = 'data/test.cache'; |
---|
60 | my $princ = get_principal; |
---|
61 | return unless $princ; |
---|
62 | my @commands = ([ qw(kinit -k -t data/test.keytab), $princ ], |
---|
63 | [ qw(kinit -t data/test.keytab), $princ ], |
---|
64 | [ qw(kinit -k -K data/test.keytab), $princ ]); |
---|
65 | my $status; |
---|
66 | for (@commands) { |
---|
67 | $status = system "@$_ > /dev/null < /dev/null"; |
---|
68 | if ($status == 0) { |
---|
69 | return 1; |
---|
70 | } |
---|
71 | } |
---|
72 | warn "Unable to obtain Kerberos tickets\n"; |
---|
73 | unless (-f 'data/pid') { |
---|
74 | sleep 1; |
---|
75 | } |
---|
76 | stop_remctld; |
---|
77 | return; |
---|
78 | } |
---|
79 | |
---|
80 | # Test setup. |
---|
81 | chdir '@abs_top_builddir@/tests'; |
---|
82 | my $okay = (-f 'data/test.principal' && -f 'data/test.keytab'); |
---|
83 | if ($okay) { |
---|
84 | start_remctld; |
---|
85 | $okay = run_kinit; |
---|
86 | } |
---|
87 | SKIP: { |
---|
88 | skip "no Kerberos configuration", $total unless $okay; |
---|
89 | |
---|
90 | sleep 1 unless -f 'data/pid'; |
---|
91 | die "remctld did not start" unless -f 'data/pid'; |
---|
92 | |
---|
93 | # Now we can finally run our tests. Basic interface, success. |
---|
94 | my $principal = get_principal; |
---|
95 | my $result = remctl ('localhost', 14373, $principal, 'test', 'test'); |
---|
96 | isa_ok ($result, 'Net::Remctl::Result', 'Basic remctl return'); |
---|
97 | is ($result->status, 0, '... exit status'); |
---|
98 | is ($result->stdout, "hello world\n", '... stdout output'); |
---|
99 | is ($result->stderr, undef, '... stderr output'); |
---|
100 | is ($result->error, undef, '... error return'); |
---|
101 | |
---|
102 | # Basic interface, failure. |
---|
103 | $result = remctl ('localhost', 14373, $principal, 'test', 'bad-command'); |
---|
104 | isa_ok ($result, 'Net::Remctl::Result', 'Error remctl return'); |
---|
105 | is ($result->status, 0, '... exit status'); |
---|
106 | is ($result->stdout, undef, '... stdout output'); |
---|
107 | is ($result->stderr, undef, '... stderr output'); |
---|
108 | is ($result->error, 'Unknown command', '... error return'); |
---|
109 | |
---|
110 | # Complex interface, success. |
---|
111 | my $remctl = Net::Remctl->new; |
---|
112 | isa_ok ($remctl, 'Net::Remctl', 'Object'); |
---|
113 | is ($remctl->error, 'no error', '... no error set'); |
---|
114 | ok ($remctl->open ('localhost', 14373, $principal), 'Connect to server'); |
---|
115 | is ($remctl->error, 'no error', '... no error set'); |
---|
116 | ok ($remctl->command ('test', 'test'), 'Send successful command'); |
---|
117 | is ($remctl->error, 'no error', '... no error set'); |
---|
118 | my $output = $remctl->output; |
---|
119 | isa_ok ($output, 'Net::Remctl::Output', 'Output token'); |
---|
120 | is ($output->type, 'output', '... of type output'); |
---|
121 | is ($output->length, 12, '... and length 12'); |
---|
122 | is ($output->data, "hello world\n", '... with the right data'); |
---|
123 | is ($output->stream, 1, '... and the right stream'); |
---|
124 | $output = $remctl->output; |
---|
125 | isa_ok ($output, 'Net::Remctl::Output', 'Second output token'); |
---|
126 | is ($output->type, 'status', '... of type status'); |
---|
127 | is ($output->status, 0, '... with status 0'); |
---|
128 | |
---|
129 | # Complex interface, failure. |
---|
130 | ok ($remctl->command ('test', 'bad-command'), 'Send failing command'); |
---|
131 | is ($remctl->error, 'no error', '... no error set'); |
---|
132 | $output = $remctl->output; |
---|
133 | isa_ok ($output, 'Net::Remctl::Output', 'Output token'); |
---|
134 | is ($output->type, 'error', '... of type error'); |
---|
135 | is ($output->data, 'Unknown command', '... with the error message'); |
---|
136 | is ($output->error, 5, '... and the right code'); |
---|
137 | } |
---|
138 | |
---|
139 | END { |
---|
140 | stop_remctld; |
---|
141 | } |
---|