source: web/old/remctl-2.14/perl/t/api.t.in @ f6f3e91

web
Last change on this file since f6f3e91 was f6f3e91, checked in by Jessica B. Hamrick <jhamrick@…>, 15 years ago

Preserve directory hierarchy (not sure what happened to it)

  • Property mode set to 100644
File size: 4.8 KB
Line 
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
12BEGIN { our $total = 30 }
13use Test::More tests => $total;
14
15use Net::Remctl;
16
17# Returns the principal to use for authentication.
18sub 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.
27sub 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.
47sub 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.
58sub 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.
81chdir '@abs_top_builddir@/tests';
82my $okay = (-f 'data/test.principal' && -f 'data/test.keytab');
83if ($okay) {
84    start_remctld;
85    $okay = run_kinit;
86}
87SKIP: {
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
139END {
140    stop_remctld;
141}
Note: See TracBrowser for help on using the repository browser.