File Coverage

blib/lib/Net/SOCKS.pm

Criterion	Covered	Total	%
statement	12	14	85.7
branch	0	2	0.0
condition			n/a
subroutine	4	5	80.0
pod	0	1	0.0
total	16	22	72.7

package Net::SOCKS;

# Copyright (c) 1997-1998 Clinton Wong. All rights reserved.
# This program is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.

use strict;
use vars qw($VERSION @ISA @EXPORT);
use IO::Socket;
use Carp;

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);
@EXPORT = qw();

$VERSION = '0.03';

# Status code exporter adapted from HTTP::Status by Gisle Aas.
# Please note - users of this module should not use hard coded numbers
#               in their programs.  Always use the SOCKS_ version of
#               the status code, which are the descriptions below
#               converted to uppercase and _ replacing dash and SPACE.

my %status_code = (
  1  =>   "general SOCKS server failure",        # SOCKS5
  2  =>   "connection not allowed by ruleset",
  3  =>   "network unreachable",
  4  =>   "host unreachable",
  5  =>   "connection refused",
  6  =>   "TTL expired",
  7  =>   "command not supported",
  8  =>   "address type not supported",
  90 =>   "okay",                                # SOCKS4
  91 =>   "failed",
  92 =>   "no ident",
  93 =>   "user mismatch",
  100 =>  "incomplete auth",                    # generic
  101 =>  "bad auth",
  102 =>  "server denies auth method",
  202  => "missing SOCKS server net data",
  203  => "missing peer net data",
  204  => "SOCKS server unavailable",
  205  => "timeout",
  206  => "unsupported protocol version",
  207  => "unsupported address type",
  208  => "hostname lookup failure"
);

my $mnemonic_code = '';
my ($code, $message);
while (($code, $message) = each %status_code) {
  # create mnemonic subroutines
  $message =~ tr/a-z \-/A-Z__/;
  $mnemonic_code .= "sub SOCKS_$message () { $code }\t";
  $mnemonic_code .= "push(\@EXPORT, 'SOCKS_$message');\n";
}
eval $mnemonic_code; # only one eval for speed
die if $@;

sub status_message {
  return undef unless exists $status_code{ $_[0] };
  $status_code{ $_[0] };
}

1;
__END__