##
/* try to decode a socks5 header */
#define SSH_SOCKS5_AUTHDONE 0x1000
#define SSH_SOCKS5_NOAUTH 0x00
#define SSH_SOCKS5_IPV4 0x01
#define SSH_SOCKS5_DOMAIN 0x03
#define SSH_SOCKS5_IPV6 0x04
#define SSH_SOCKS5_CONNECT 0x01
#define SSH_SOCKS5_SUCCESS 0x00
/* ARGSUSED */
static int
channel_decode_socks5(Channel *c, fd_set *readset, fd_set *writeset)
{
struct {
u_int8_t version;
u_int8_t command;
u_int8_t reserved;
u_int8_t atyp;
} s5_req, s5_rsp;
u_int16_t dest_port;
u_char *p, dest_addr[255+1], ntop[INET6_ADDRSTRLEN];
u_int have, need, i, found, nmethods, addrlen, af;
debug2("channel %d: decode socks5", c->self);
p = buffer_ptr(&c->input);
if (p[0] != 0x05)
return -1;
have = buffer_len(&c->input);
if (!(c->flags & SSH_SOCKS5_AUTHDONE)) {
/* format: ver | nmethods | methods */
if (have < 2)
return 0;
nmethods = p[1];
if (have < nmethods + 2)
return 0;
/* look for method: "NO AUTHENTICATION REQUIRED" */
for (found = 0, i = 2; i < nmethods + 2; i++) {
if (p[i] == SSH_SOCKS5_NOAUTH) {
found = 1;
break;
}
}
if (!found) {
debug("channel %d: method SSH_SOCKS5_NOAUTH not found",
c->self);
return -1;
}
buffer_consume(&c->input, nmethods + 2);
buffer_put_char(&c->output, 0x05); /* version */
buffer_put_char(&c->output, SSH_SOCKS5_NOAUTH); /* method */
FD_SET(c->sock, writeset);
c->flags |= SSH_SOCKS5_AUTHDONE;
debug2("channel %d: socks5 auth done", c->self);
return 0; /* need more */
}
debug2("channel %d: socks5 post auth", c->self);
if (have < sizeof(s5_req)+1)
return 0; /* need more */
memcpy(&s5_req, p, sizeof(s5_req));
if (s5_req.version != 0x05 ||
s5_req.command != SSH_SOCKS5_CONNECT ||
s5_req.reserved != 0x00) {
debug2("channel %d: only socks5 connect supported", c->self);
return -1;
}
switch (s5_req.atyp){
case SSH_SOCKS5_IPV4:
addrlen = 4;
af = AF_INET;
break;
case SSH_SOCKS5_DOMAIN:
addrlen = p[sizeof(s5_req)];
af = -1;
break;
case SSH_SOCKS5_IPV6:
addrlen = 16;
af = AF_INET6;
break;
default:
debug2("channel %d: bad socks5 atyp %d", c->self, s5_req.atyp);
return -1;
}
need = sizeof(s5_req) + addrlen + 2;
if (s5_req.atyp == SSH_SOCKS5_DOMAIN)
need++;
if (have < need)
return 0;
buffer_consume(&c->input, sizeof(s5_req));
if (s5_req.atyp == SSH_SOCKS5_DOMAIN)
buffer_consume(&c->input, 1); /* host string length */
buffer_get(&c->input, (char *)&dest_addr, addrlen);
buffer_get(&c->input, (char *)&dest_port, 2);
dest_addr[addrlen] = '\0';
if (c->path != NULL) {
xfree(c->path);
c->path = NULL;
}
if (s5_req.atyp == SSH_SOCKS5_DOMAIN) {
if (addrlen >= NI_MAXHOST) {
error("channel %d: dynamic request: socks5 hostname "
"\"%.100s\" too long", c->self, dest_addr);
return -1;
}
c->path = xstrdup(dest_addr);
} else {
if (inet_ntop(af, dest_addr, ntop, sizeof(ntop)) == NULL)
return -1;
c->path = xstrdup(ntop);
}
c->host_port = ntohs(dest_port);
debug2("channel %d: dynamic request: socks5 host %s port %u command %u",
c->self, c->path, c->host_port, s5_req.command);
s5_rsp.version = 0x05;
s5_rsp.command = SSH_SOCKS5_SUCCESS;
s5_rsp.reserved = 0; /* ignored */
s5_rsp.atyp = SSH_SOCKS5_IPV4;
((struct in_addr *)&dest_addr)->s_addr = INADDR_ANY;
dest_port = 0; /* ignored */
buffer_append(&c->output, &s5_rsp, sizeof(s5_rsp));
buffer_append(&c->output, &dest_addr, sizeof(struct in_addr));
buffer_append(&c->output, &dest_port, sizeof(dest_port));
return 1;
}
##
##
sub acos { atan2( sqrt(1-$_[0]*$_[0]), $_[0] ) }
sub asin { atan2( $_[0], sqrt(1-$_[0]*$_[0]) ) }
my $pi= atan2(0,-1);
my @c= ( 33.943603, -118.408189, 39.17965, -76.668824 );
my $lat1= $c[0]/180*$pi;
my $lat2= $c[2]/180*$pi;
my $dlong= ($c[1]-$c[3])/180*$pi;
my $ang= acos( sin($lat1)*sin($lat2)
+ cos($lat1)*cos($lat2)*cos($dlong) );
my $max= $ang * 3_963.19059;
my $min= $ang * 3_949.90257;
printf "%.1f .. %.1f miles (%.2f range)\n", $min, $max, $max-$min;
my $h1= sin(($lat1-$lat2)/2);
my $h2= sin($dlong/2);
$ang= 2*asin( sqrt( $h1*$h1 + cos($lat1)*cos($lat2)*$h2*$h2 ) );
$max= $ang * 3_963.19059;
$min= $ang * 3_949.90257;
printf "%.1f .. %.1f miles (%.2f range)\n", $min, $max, $max-$min;
2318.6 .. 2326.4 miles (7.80 range)
2318.6 .. 2326.4 miles (7.80 range)
##
##
# Change within substr (or zero-width on an edge)
if( $beg < $end # Not empty
|| $b == $e # Both empty (identical)
|| ( $b < $beg
&& $end < $e )
) { # Or not on an edge
# changes within substr, change length:
$e += $dif;
}
##
##
a b c d e f g . h i j k l-o p . q r s . t u v . www x . y & z .
a b c d e f g . h i j . k l m . n o p q r s t . u v www x y z .
##
##
PerlMonks Full-Page Chat
No Frames? Chat Here
##
##
:let @p="L?^#!\r/^__END__\ry''''p!Gperl\rG"
##
##
#!/usr/bin/perl -n
next if /.../;
s/.../.../;
s/.../.../;
if( /.../ ) {
my( $date, $time )= /(\d([-/\d]+\d) (\d([\d:.]+\d)/;
my( $hr, $min, $sec, $ms )= split /[:.]/, $time;
my $now= $ms/1000 + $sec + 60*( $min + 60*$hr );
if( $Then ) {
$sec= $now - $Then;
$min= int( $sec / 60 );
$sec -= 60*$min;
$_= sprintf "+%d:%06.3f %s", $min, $sec, $_;
}
$Then= $now;
}
print;
__END__
...
##
##
SOCKET
win32_socket(int af, int type, int protocol)
{
SOCKET s;
StartSockets();
s = socket(af, type, protocol);
if( s == INVALID_SOCKET || s == NULL )
errno = WSAGetLastError();
else
s = OPEN_SOCKET(s);
return s;
}
##
##
C C
v v
_ _ _ _ _ __ _ _ _ _ _
_ _ _ _ _ _
^
C
##
##
my $message;
my $q;
my $reTime='\d*\.?\d+(?:\s*(?:h(?:ours?)?'
. '|m(?:in(?:ute)?s?)?|s(?:ec(?:ond)?s?)?))?';
if( $message !~ m{
^/(borg|consume)
\s+(?: (\S+) | \[ ([^\]]+) \] )
(?:| \s+($reTime)
(?:| \s+(\S.*) )
)\s*$
}ix
) {
$q->param( "sentmessage",
qq[Syntax error in /borg; command ignored.]
);
return;
}
##
##
Final $ should be \$ or $name at line 6, within pattern
syntax error at line 11, near "!~ m{
^/(borg|consume)
\s+(?: (\S+) | \[ ([^\]]+) \] )
(?:| \s+($reTime)
(?:| \s+(\S.*) )
)\s* $
}ix"
(Might be a runaway multi-line {} string starting on line 5)
syntax error at line 17, near ";
}"
##
##
#!/usr/bin/perl
use strict;
use warnings;
sub make_html {
my $array= shift @_;
my $rows= $#$array;
my $cols= $#{$array->[0]};
my @html;
my @last= @{ $array->[$rows] };
my @span= (1) x (1+$cols);
push @html, "\n";
foreach my $row ( reverse [], @$array[0..$rows-1] ) {
push @html, "\n";
foreach my $col ( reverse 0..$cols ) {
if( @$row && $last[$col] eq $row->[$col] ) {
$span[$col]++;
} else {
my $span= 1==$span[$col] ? "" : " rowspan='$span[$col]'";
push @html, "$last[$col] \n";
$span[$col]= 1;
$last[$col]= $row->[$col] if @$row;
}
}
push @html, "\n";
}
push @html, "\n";
return join '', reverse @html;
}
my @t=(
[ qw( A B C D E F H ) ],
[ qw( A B C D E G I ) ],
[ qw( A B C D F G J ) ],
[ qw( A B C E F G K ) ],
[ qw( A B D E F G L ) ],
[ qw( A C D E F G M ) ],
[ qw( B C D E F G N ) ],
);
print make_html(\@t);
####
#!/usr/bin/perl -w
use strict;
for my $str ( @ARGV ) {
my @stack;
my $list= [];
for my $s ( $str =~ m/[()]|[^()]+/g ) {
if( '(' eq $s ) {
push @stack, $list;
push @$list, [];
$list= $list->[-1];
} elsif( ')' eq $s ) {
if( ! @stack ) {
die "Unmatched ')'";
}
$list= pop @stack;
} else {
push @$list, $s;
}
}
if( @stack ) {
die 0+@stack, " unclosed '('s";
}
warn "Done.\n";
}
##
##
class GetStreamString {
# Nothing to see here.
# Just a type to allow us to define the below operator.
};
const char* operator<<( std::ostream& ostr, const GetStreamString& )
{
return dynamic_cast< std::stringstream& >( ostr ).str().c_str();
}
##
##
function_that_accepts_some_string_argument( "Like this" );
function_that_accepts_some_string_argument(
std::stringstream()
<< "Make a dynamic string with " << n
<< " " << name << "s filled in"
<< GetStreamString()
);
##
##
#!/usr/bin/perl -w
use strict;
sub X() { 0 }
sub Y() { 1 }
# Given a line segment from point A to point B:
my @A= splice @ARGV, 0, 2;
my @B= splice @ARGV, 0, 2;
# And another point P:
my @P= splice @ARGV, 0, 2;
# Translate point A to be the origin of the
# plane (subtract A from the other points):
my @B1= ( $B[X]-$A[X], $B[Y]-$A[Y] );
my @P1= ( $P[X]-$A[X], $P[Y]-$A[Y] );
# Rotate the plane so B is on the X axis:
# (Also expands the plane by a factor
# equal to the length of the line segment)
@P1= ( $P1[X]*$B1[X] + $P1[Y]*$B1[Y],
$P1[Y]*$B1[X] - $P1[X]*$B1[Y] );
@B1= ( $B1[X]*$B1[X] + $B1[Y]*$B1[Y], 0 );
# You can now find the closest point on the line:
# (let $t=0 represent A and $t=1 represent B)
my $t= $P1[X]/$B1[X];
my @I= ( (1-$t)*$A[X] + $t*$B[X],
(1-$t)*$A[Y] + $t*$B[Y] );
# And/or, find the length of the line segment
# and the distance from the point to the line:
my $len= sqrt( $B1[X] );
# Add abs() if you don't want to know
# which side of the line the point is on:
my $dist= $P1[Y]/$len;
# Might as well compute the area of our triangle:
my $area= $len*abs($dist)/2;
print "I=( $I[X], $I[Y] ) t=$t\n";
print "dist=$dist len=$len area=$area\n";
##
##
use Algorithm::Loops 'NextPermute';
my @dig= ( 1..9 );
do {
my $s= my $v= join "", reverse @dig;
chop($s) while $s && 0 == $s % length($s);
warn $v, $/ if ! $s;
} while( NextPermute(@dig) );
##
##
sub READLINEX {
my $self= shift;
my $svBuf= \$self->{BUFFER};
my $delim= $self->{INPUT_REGEX};
my $len= $self->{READLEN} || 4096;
my $margin= $self->{READMARGIN} || 128;
while( $$svBuf !~ /$delim/
|| length($$svBuf)-$margin < $+[0]
) {
$pos= length($$svBuf);
$self->READ( $$svBuf, $pos, $len )
or last;
}
$pos= $$svBuf =~ /$delim/ ? $+[0] : length($$svBuf);
return substr( $$svBuf, 0, $pos, "" );
}
##
##
BEGIN {
require UNIVERSAL;
*isa= \&UNIVERSAL::isa;
}
sub Compare {
my( $ctx )= 3==@_ ? pop(@_) : {};
my( $x, $y )= \( @_ );
return 0 if defined($$x) != defined($$y);
return 0 if ref($$x) ne ref($$y);
return $$x eq $$y if ! ref($$x);
return 1
if $$x == $$y
|| $ctx->{0+$$x,0+$$y}
|| $ctx->{0+$$y,0+$$x}++;
return Compare($$$x,$$$y,$ctx)
if isa($$x,'SCALAR') || isa($$x,'REF');
if( isa($$x,'ARRAY') ) {
return 0 if @$$x != @$$y;
for my $idx ( 0..$#$$x ) {
return 0
if ! Compare($$x->[$idx],$$y->[$idx],$ctx);
}
return 1;
}
if( isa($$x,'HASH') ) {
return 0 if keys %$$x != keys %$$y;
for my $key ( keys %$$x ) {
return 0
unless exists $$y->{$key}
&& Compare($$x->{$key},$$y->{$key},$ctx);
}
return 1;
}
require Carp;
Carp::croak( "Unsupported data type (",ref($$x),")" );
}
##
##
while( $pattern =~ m< # Tokenize the potential regex
\G # Don't let it skip bits
( # Return what we find
\\x.. # A hexidecimal character
| \\0[0-7]{0,3} # An octal character
| \\\D # A boring escaped character
| [^\[\{] # Not '[' nor '{' so treat as a token #}
| \{(?=\D) # Literal but unescaped '{' #}
| \{\d+,?\d*} # Bounded repetitions
| \[ # '[' starts a character class
\^? # '^' can go in front of the literal ']'
\]? # ']' at start is taken literally
(?: # Inside, there can be some subtokens
[^\]] # Not '[' so isn't a subtoken
| \[(?=[^.=:]) # '[' but not '[.', '[=', nor '[:'
| \[ # Must be '[' of '[.', '[=', or '[:'
[^\]]* # Anything but the closing ']'
\] # ']' closes out subtoken
)* # Any number of subtokens
\] # ']' closes out the character class
| (.) # Found something invalid (sets $2)
)
>xsg
) {
Strange *+?{} on zero-length expression
##
##
sub fletch {
my( $str )= @_;
my( $sum1, $sum2 );
for my $ch ( unpack "C*", $str ) {
$sum1 += $ch;
$sum1 -= 255 if 255 < $sum1;
$sum2 += $sum1;
$sum2 -= 255 if 255 < $sum2;
}
return pack "C*", $sum2, $sum1;
}
##
##
BEGIN {
my $countFile= "/path/to/count/file";
my $fh= do { local(COUNT); \*COUNT };
open $fh, ">> $countFile" or die "Can't append to $countFile: $!\n";
my $byte= "\x80" | pack "C", 0x7f & $$;
sub getCounter {
my $start= tell($fh);
print $fh $byte;
my $end= tell($fh);
return $start if $start+1 == $end;
seek($fh,$start,0);
my $buf;
read( $fh, $buf, $end-$start );
my $offset= index($buf,$byte);
return $start + $offset if -1 == index($buf,$byte,$offset);
seek( $fh, $start+$offset, 0 );
my $lock;
my $new;
while( 1 ) {
$lock= fileLock->new( $fh, $start+$offset, 1 );
read( $fh, $new, 1 );
if( $new eq $byte ) {
$new &= "\x7f";
seek( $fh, $start+$offset, 0 );
write( $fh, $new );
return $start+$offset;
}
$offset= index($buf,$byte,$offset);
die "Impossible!" if $offset < 0;
}
}
}
##
##
package Win32::SelectablePipe;
use strict;
use Socket;
use POSIX ();
use vars qw( @EXPORT @EXPORT_OK );
BEGIN {
require Exporter;
@EXPORT= qw( pipe );
@EXPORT_OK= qw( FIONBIO EAGAIN );
*import= \&Exporter::import;
}
sub SO_OPENTYPE { 0x7008 }
sub POSIX::FIONBIO { ( 0x80000000 | (4<<16) | (unpack('c','f')<<8) | 126 ) }
# 0x8004667E
sub POSIX::EAGAIN { 10035 }
sub POSIX::EISCONN { 10056 }
sub pipe {
my( $one, $two )= @_;
my( $server )= do { local(*SERVER); *SERVER };
if( 2 != @_ ) {
require Carp;
Carp::croak( "Win32::SelectablePipe usage: pipe(*ONE,*TWO)" );
}
{
my $pkg= caller;
for my $handle ( $one, $two ) {
if( ! ref($handle)
&& "GLOB" ne ref(\$handle)
&& $handle !~ /'|::/ ) {
$handle= "$pkg::$handle"
}
}
}
my $tcp= getprotobyname('tcp');
socket( $server, PF_INET, SOCK_STREAM, $tcp )
or die "Can't create TCP socket ($server): $!";
socket( $two, PF_INET, SOCK_STREAM, $tcp )
or die "Can't create TCP socket ($two): $!";
my $local= gethostbyname('localhost')
or die "Can't find localhost: $!";
my $addr= sockaddr_in( 0, $local )
or die "Can't build localhost address: $!";
bind( $server, $addr )
or die "Can't bind socket ($server) to localhost address: ",0+$!;
bind( $two, $addr )
or die "Can't bind socket ($two) to localhost address: ",0+$!;
listen( $server, 1 )
or die "Can't listen on socket ($server): ",0+$!;
$addr= getsockname( $server )
or die "Can't get socket ($server) address: ",0+$!;
{
my $true= 1;
ioctl( $two, POSIX::FIONBIO(), \$true )
or die "Can't ioctl socket ($two) to non-blocking: ", 0+$!;
}
if( connect( $two, $addr ) ) {
warn "Strange, connect() succeeded?";
} elsif( $! != POSIX::EAGAIN ) {
die "Can't non-blockingly connect: ", 0+$!;
}
accept( $one, $server ) or die "Can't accept: ", 0+$!;
sleep( 1 );
die "Can't connect: ", 0+$!;
if ! connect( $two, $addr ) && $! != POSIX::EISCONN;
close( $server );
return 1;
}
# Total *HACK* to allow winsock connect() to work on non-blocking sockets
# Culprit is in perl source /win32/win32sck.c function set_socktype. We
# undo the result of this function. See MSDN support on overlapped I/O
# for info: http://support.microsoft.com/support/kb/articles/Q181/6/11.ASP
#BEGIN {
# my $sock = gensym();
# socket( $sock, PF_INET, SOCK_STREAM, getprotobyname('tcp') )
# or die "ERROR - can't create socket\n";
# setsockopt( $sock, SOL_SOCKET, SO_OPENTYPE, 0 )
# or die "PORTABLE::BEGIN ERROR - Can't setsockopt to overlapped: $!\n";
# close $sock;
#}
1;
##
##
my ($line,$file)= ( 3+__LINE__, __FILE__ );
my $func = qq(
#line $line "$file"
sub $tagname {
shift if \$_[0] &&
##
##
Titel
If you see this as rendered HTML your browser sucks