ext/Sys/Syslog/t/syslog.t

   1 #!/usr/bin/perl -Tw
   2
   3 BEGIN {
   4     if( $ENV{PERL_CORE} ) {
   5         chdir 't';
   6         @INC = '../lib';
   7     }
   8 }
   9
  10 use strict;
  11 use Config;
  12 use File::Spec;
  13 use Test::More;
  14
  15 # check that the module is at least available
  16 plan skip_all => "Sys::Syslog was not build"
  17   unless $Config{'extensions'} =~ /\bSyslog\b/;
  18
  19 # we also need Socket
  20 plan skip_all => "Socket was not build"
  21   unless $Config{'extensions'} =~ /\bSocket\b/;
  22
  23 my $tests;
  24 plan tests => $tests;
  25
  26 BEGIN { $tests = 1 }
  27 # ok, now loads them
  28 eval 'use Socket';
  29 use_ok('Sys::Syslog', ':standard', ':extended', ':macros');
  30
  31 BEGIN { $tests += 1 }
  32 # check that the documented functions are correctly provided
  33 can_ok( 'Sys::Syslog' => qw(openlog syslog syslog setlogmask setlogsock closelog) );
  34
  35
  36 BEGIN { $tests += 1 }
  37 # check the diagnostics
  38 # setlogsock()
  39 eval { setlogsock() };
  40 like( $@, qr/^Invalid argument passed to setlogsock; must be 'stream', 'unix', 'tcp', 'udp' or 'inet'/,
  41     "calling setlogsock() with no argument" );
  42
  43 BEGIN { $tests += 3 }
  44 # syslog()
  45 eval { syslog() };
  46 like( $@, qr/^syslog: expecting argument \$priority/,
  47     "calling syslog() with no argument" );
  48
  49 eval { syslog(undef) };
  50 like( $@, qr/^syslog: expecting argument \$priority/,
  51     "calling syslog() with one undef argument" );
  52
  53 eval { syslog('') };
  54 like( $@, qr/^syslog: expecting argument \$format/,
  55     "calling syslog() with one empty argument" );
  56
  57 BEGIN { $tests += 1 }
  58 # setlogsock()
  59 eval { setlogsock() };
  60 like( $@, qr/^Invalid argument passed to setlogsock; must be 'stream', 'unix', 'tcp', 'udp' or 'inet'/,
  61     "calling setlogsock() with no argument" );
  62
  63 my $test_string = "uid $< is testing Perl $] syslog(3) capabilities";
  64 my $r = 0;
  65
  66 BEGIN { $tests += 8 }
  67 # try to open a syslog using a Unix or stream socket
  68 SKIP: {
  69     skip "can't connect to Unix socket: _PATH_LOG unavailable", 8
  70       unless -e Sys::Syslog::_PATH_LOG();
  71
  72     # The only known $^O eq 'svr4' that needs this is NCR MP-RAS,
  73     # but assuming 'stream' in SVR4 is probably not that bad.
  74     my $sock_type = $^O =~ /^(solaris|irix|svr4|powerux)$/ ? 'stream' : 'unix';
  75
  76     eval { setlogsock($sock_type) };
  77     is( $@, '', "setlogsock() called with '$sock_type'" );
  78     TODO: {
  79         local $TODO = "minor bug";
  80         ok( $r, "setlogsock() should return true: '$r'" );
  81     }
  82
  83     # open syslog with a "local0" facility
  84     SKIP: {
  85         # openlog()
  86         $r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
  87         skip "can't connect to syslog", 6 if $@ =~ /^no connection to syslog available/;
  88         is( $@, '', "openlog() called with facility 'local0'" );
  89         ok( $r, "openlog() should return true: '$r'" );
  90
  91         # syslog()
  92         $r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
  93         is( $@, '', "syslog() called with level 'info'" );
  94         ok( $r, "syslog() should return true: '$r'" );
  95
  96         # closelog()
  97         $r = eval { closelog() } || 0;
  98         is( $@, '', "closelog()" );
  99         ok( $r, "closelog() should return true: '$r'" );
 100     }
 101 }
 102
 103
 104 BEGIN { $tests += 20 * 6 }
 105 # try to open a syslog using all the available connection methods
 106 for my $sock_type (qw(stream unix inet tcp udp console)) {
 107     SKIP: {
 108         # setlogsock() called with an arrayref
 109         $r = eval { setlogsock([$sock_type]) } || 0;
 110         skip "can't use '$sock_type' socket", 20 unless $r;
 111         is( $@, '', "setlogsock() called with ['$sock_type']" );
 112         ok( $r, "setlogsock() should return true: '$r'" );
 113
 114         # setlogsock() called with a single argument
 115         $r = eval { setlogsock($sock_type) } || 0;
 116         skip "can't use '$sock_type' socket", 18 unless $r;
 117         is( $@, '', "setlogsock() called with '$sock_type'" );
 118         ok( $r, "setlogsock() should return true: '$r'" );
 119
 120         # openlog() without option NDELAY
 121         $r = eval { openlog('perl', '', 'local0') } || 0;
 122         skip "can't connect to syslog", 16 if $@ =~ /^no connection to syslog available/;
 123         is( $@, '', "openlog() called with facility 'local0' and without option 'ndelay'" );
 124         ok( $r, "openlog() should return true: '$r'" );
 125
 126         # openlog() with the option NDELAY
 127         $r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
 128         skip "can't connect to syslog", 14 if $@ =~ /^no connection to syslog available/;
 129         is( $@, '', "openlog() called with facility 'local0' with option 'ndelay'" );
 130         ok( $r, "openlog() should return true: '$r'" );
 131
 132         # syslog() with negative level, should fail
 133         $r = eval { syslog(-1, "$test_string by connecting to a $sock_type socket") } || 0;
 134         like( $@, '/^syslog: invalid level\/facility: /', "syslog() called with level -1" );
 135         ok( !$r, "syslog() should return false: '$r'" );
 136
 137         # syslog() with levels "info" and "notice" (as a strings), should fail
 138         $r = eval { syslog('info,notice', "$test_string by connecting to a $sock_type socket") } || 0;
 139         like( $@, '/^syslog: too many levels given: notice/', "syslog() called with level 'info,notice'" );
 140         ok( !$r, "syslog() should return false: '$r'" );
 141
 142         # syslog() with facilities "local0" and "local1" (as a strings), should fail
 143         $r = eval { syslog('local0,local1', "$test_string by connecting to a $sock_type socket") } || 0;
 144         like( $@, '/^syslog: too many facilities given: local1/', "syslog() called with level 'info,notice'" );
 145         ok( !$r, "syslog() should return false: '$r'" );
 146
 147         # syslog() with level "info" (as a string), should pass
 148         $r = eval { syslog('info', "$test_string by connecting to a $sock_type socket (errno=%m)") } || 0;
 149         is( $@, '', "syslog() called with level 'info' (string)" );
 150         ok( $r, "syslog() should return true: '$r'" );
 151
 152         # syslog() with level "info" (as a macro), should pass
 153         $r = eval { syslog(LOG_INFO(), "$test_string by connecting to a $sock_type socket (errno=%m)") } || 0;
 154         is( $@, '', "syslog() called with level 'info' (macro)" );
 155         ok( $r, "syslog() should return true: '$r'" );
 156
 157         # syslog() with facility "kern" (as a string), should fail
 158         #$r = eval { syslog('kern', "$test_string by connecting to a $sock_type socket") } || 0;
 159         #like( $@, '/^syslog: invalid level/facility: kern/', "syslog() called with facility 'kern'" );
 160         #ok( !$r, "syslog() should return false: '$r'" );
 161
 162         # syslog() with facility "kern" (as a macro), should fail
 163         #$r = eval { syslog(LOG_KERN, "$test_string by connecting to a $sock_type socket") } || 0;
 164         #like( $@, '/^syslog: invalid level/facility: 0/', "syslog() called with facility 'kern'" );
 165         #ok( !$r, "syslog() should return false: '$r'" );
 166
 167         SKIP: {
 168             skip "skipping closelog() tests for 'console'", 2 if $sock_type eq 'console';
 169             # closelog()
 170             $r = eval { closelog() } || 0;
 171             is( $@, '', "closelog()" );
 172             ok( $r, "closelog() should return true: '$r'" );
 173         }
 174     }
 175 }
 176
 177
 178 BEGIN { $tests += 10 }
 179 # setlogsock() with "stream" and an undef path
 180 $r = eval { setlogsock("stream", undef ) } || '';
 181 is( $@, '', "setlogsock() called, with 'stream' and an undef path" );
 182 ok( $r, "setlogsock() should return true: '$r'" );
 183
 184 # setlogsock() with "stream" and an empty path
 185 $r = eval { setlogsock("stream", '' ) } || '';
 186 is( $@, '', "setlogsock() called, with 'stream' and an empty path" );
 187 ok( !$r, "setlogsock() should return false: '$r'" );
 188
 189 # setlogsock() with "stream" and /dev/null
 190 $r = eval { setlogsock("stream", '/dev/null' ) } || '';
 191 is( $@, '', "setlogsock() called, with 'stream' and '/dev/null'" );
 192 ok( $r, "setlogsock() should return true: '$r'" );
 193
 194 # setlogsock() with "stream" and a non-existing file
 195 $r = eval { setlogsock("stream", 'test.log' ) } || '';
 196 is( $@, '', "setlogsock() called, with 'stream' and 'test.log' (file does not exist)" );
 197 ok( !$r, "setlogsock() should return false: '$r'" );
 198
 199 # setlogsock() with "stream" and a local file
 200 SKIP: {
 201     my $logfile = "test.log";
 202     open(LOG, ">$logfile") or skip "can't create file '$logfile': $!", 2;
 203     close(LOG);
 204     $r = eval { setlogsock("stream", $logfile ) } || '';
 205     is( $@, '', "setlogsock() called, with 'stream' and '$logfile' (file exists)" );
 206     ok( $r, "setlogsock() should return true: '$r'" );
 207     unlink($logfile);
 208 }
 209
 210
 211 BEGIN { $tests += 3 + 4 * 3 }
 212 # setlogmask()
 213 {
 214     my $oldmask = 0;
 215
 216     $oldmask = eval { setlogmask(0) } || 0;
 217     is( $@, '', "setlogmask() called with a null mask" );
 218     $r = eval { setlogmask(0) } || 0;
 219     is( $@, '', "setlogmask() called with a null mask (second time)" );
 220     is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
 221
 222     my @masks = (
 223         LOG_MASK(LOG_ERR()),
 224         ~LOG_MASK(LOG_INFO()),
 225         LOG_MASK(LOG_CRIT()) | LOG_MASK(LOG_ERR()) | LOG_MASK(LOG_WARNING()),
 226     );
 227
 228     for my $newmask (@masks) {
 229         $r = eval { setlogmask($newmask) } || 0;
 230         is( $@, '', "setlogmask() called with a new mask" );
 231         is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
 232         $r = eval { setlogmask(0) } || 0;
 233         is( $@, '', "setlogmask() called with a null mask" );
 234         is( $r, $newmask, "setlogmask() must return the new mask");
 235         setlogmask($oldmask);
 236     }
 237 }