[7892] in Perl-Users-Digest
Perl-Users Digest, Issue: 1517 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Dec 21 09:07:18 1997
Date: Sun, 21 Dec 97 06:00:47 -0800
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sun, 21 Dec 1997 Volume: 8 Number: 1517
Today's topics:
Re: a Perl crypt function question (Martin Vorlaender)
Re: Beginner HELP needed :) (Tad McClellan)
calling two arrays in a function as variables <mbijlsma.nospam@xs4all.nl>
Re: does ne1 know... (Tad McClellan)
Dynamic s/// vs. s///i? (Joe Casadonte)
Re: How do I Access the Integer Returned by a C Program (Tad McClellan)
redirection on win95 <ophiry@agentsoft.com>
Re: Script calling another script (brian d foy)
Re: unshift, @INC, require??? <mdgoutte@asi.fr>
Re: Verifying a URL (brian d foy)
Wanna get the Week Day for a specified date <tony@buono.demon.co.uk>
Re: Which language pays most 17457 -- C++ vs. Java? (Peter Seebach)
Re: Which language pays most 17457 -- C++ vs. Java? (Peter Seebach)
Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sun, 21 Dec 1997 13:46:48 +0100
From: martin@RADIOGAGA.HARZ.DE (Martin Vorlaender)
Subject: Re: a Perl crypt function question
Message-Id: <349d0fb8.524144494f47414741@radiogaga.harz.de>
Steve Graham (dtlgc@flash.net) wrote:
: I happen to be stuck wiht a server that does not support the crypt
: function.
: Besides not encrypting the information, is there another option to perform
: this task?
There was a similar question not so long ago. I found a Java implementation
of crypt(), which I ported to Perl. On my OS/2 system, these give
(empirically) the same results.
cu,
Martin
[---cut---]
package Crypt;
=head1 NAME
B<Crypt> - software implementation of the C<crypt> function.
=head1 SYNOPSIS
C<use Crypt;>
C<$hashed = crypt($plaintext,$salt);>
=head1 DESCRIPTION
See the description of the C<crypt> function in perlfunc.pod.
=head1 AUTHORS
Written by Martin Vorlaender, martin@radiogaga.harz.de, 11-DEC-1997
Based upon Java source code written by jdumas@zgs.com, which in turn is
based upon C source code written by Eric Young, eay@psych.uq.oz.au
=cut
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(crypt);
#use strict;
my $ITERATIONS = 16;
my @con_salt =
(
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01,
0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09,
0x0A, 0x0B, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0A,
0x0B, 0x0C, 0x0D, 0x0E, 0x0F, 0x10, 0x11, 0x12,
0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x1A,
0x1B, 0x1C, 0x1D, 0x1E, 0x1F, 0x20, 0x21, 0x22,
0x23, 0x24, 0x25, 0x20, 0x21, 0x22, 0x23, 0x24,
0x25, 0x26, 0x27, 0x28, 0x29, 0x2A, 0x2B, 0x2C,
0x2D, 0x2E, 0x2F, 0x30, 0x31, 0x32, 0x33, 0x34,
0x35, 0x36, 0x37, 0x38, 0x39, 0x3A, 0x3B, 0x3C,
0x3D, 0x3E, 0x3F, 0x00, 0x00, 0x00, 0x00, 0x00,
);
my @shifts2 =
(
0, 0, 1, 1, 1, 1, 1, 1,
0, 1, 1, 1, 1, 1, 1, 0
);
my @skb0 =
(
# for C bits (numbered as per FIPS 46) 1 2 3 4 5 6
0x00000000, 0x00000010, 0x20000000, 0x20000010,
0x00010000, 0x00010010, 0x20010000, 0x20010010,
0x00000800, 0x00000810, 0x20000800, 0x20000810,
0x00010800, 0x00010810, 0x20010800, 0x20010810,
0x00000020, 0x00000030, 0x20000020, 0x20000030,
0x00010020, 0x00010030, 0x20010020, 0x20010030,
0x00000820, 0x00000830, 0x20000820, 0x20000830,
0x00010820, 0x00010830, 0x20010820, 0x20010830,
0x00080000, 0x00080010, 0x20080000, 0x20080010,
0x00090000, 0x00090010, 0x20090000, 0x20090010,
0x00080800, 0x00080810, 0x20080800, 0x20080810,
0x00090800, 0x00090810, 0x20090800, 0x20090810,
0x00080020, 0x00080030, 0x20080020, 0x20080030,
0x00090020, 0x00090030, 0x20090020, 0x20090030,
0x00080820, 0x00080830, 0x20080820, 0x20080830,
0x00090820, 0x00090830, 0x20090820, 0x20090830,
);
my @skb1 =
(
# for C bits (numbered as per FIPS 46) 7 8 10 11 12 13
0x00000000, 0x02000000, 0x00002000, 0x02002000,
0x00200000, 0x02200000, 0x00202000, 0x02202000,
0x00000004, 0x02000004, 0x00002004, 0x02002004,
0x00200004, 0x02200004, 0x00202004, 0x02202004,
0x00000400, 0x02000400, 0x00002400, 0x02002400,
0x00200400, 0x02200400, 0x00202400, 0x02202400,
0x00000404, 0x02000404, 0x00002404, 0x02002404,
0x00200404, 0x02200404, 0x00202404, 0x02202404,
0x10000000, 0x12000000, 0x10002000, 0x12002000,
0x10200000, 0x12200000, 0x10202000, 0x12202000,
0x10000004, 0x12000004, 0x10002004, 0x12002004,
0x10200004, 0x12200004, 0x10202004, 0x12202004,
0x10000400, 0x12000400, 0x10002400, 0x12002400,
0x10200400, 0x12200400, 0x10202400, 0x12202400,
0x10000404, 0x12000404, 0x10002404, 0x12002404,
0x10200404, 0x12200404, 0x10202404, 0x12202404,
);
my @skb2 =
(
# for C bits (numbered as per FIPS 46) 14 15 16 17 19 20
0x00000000, 0x00000001, 0x00040000, 0x00040001,
0x01000000, 0x01000001, 0x01040000, 0x01040001,
0x00000002, 0x00000003, 0x00040002, 0x00040003,
0x01000002, 0x01000003, 0x01040002, 0x01040003,
0x00000200, 0x00000201, 0x00040200, 0x00040201,
0x01000200, 0x01000201, 0x01040200, 0x01040201,
0x00000202, 0x00000203, 0x00040202, 0x00040203,
0x01000202, 0x01000203, 0x01040202, 0x01040203,
0x08000000, 0x08000001, 0x08040000, 0x08040001,
0x09000000, 0x09000001, 0x09040000, 0x09040001,
0x08000002, 0x08000003, 0x08040002, 0x08040003,
0x09000002, 0x09000003, 0x09040002, 0x09040003,
0x08000200, 0x08000201, 0x08040200, 0x08040201,
0x09000200, 0x09000201, 0x09040200, 0x09040201,
0x08000202, 0x08000203, 0x08040202, 0x08040203,
0x09000202, 0x09000203, 0x09040202, 0x09040203,
);
my @skb3 =
(
# for C bits (numbered as per FIPS 46) 21 23 24 26 27 28
0x00000000, 0x00100000, 0x00000100, 0x00100100,
0x00000008, 0x00100008, 0x00000108, 0x00100108,
0x00001000, 0x00101000, 0x00001100, 0x00101100,
0x00001008, 0x00101008, 0x00001108, 0x00101108,
0x04000000, 0x04100000, 0x04000100, 0x04100100,
0x04000008, 0x04100008, 0x04000108, 0x04100108,
0x04001000, 0x04101000, 0x04001100, 0x04101100,
0x04001008, 0x04101008, 0x04001108, 0x04101108,
0x00020000, 0x00120000, 0x00020100, 0x00120100,
0x00020008, 0x00120008, 0x00020108, 0x00120108,
0x00021000, 0x00121000, 0x00021100, 0x00121100,
0x00021008, 0x00121008, 0x00021108, 0x00121108,
0x04020000, 0x04120000, 0x04020100, 0x04120100,
0x04020008, 0x04120008, 0x04020108, 0x04120108,
0x04021000, 0x04121000, 0x04021100, 0x04121100,
0x04021008, 0x04121008, 0x04021108, 0x04121108,
);
my @skb4 =
(
# for D bits (numbered as per FIPS 46) 1 2 3 4 5 6
0x00000000, 0x10000000, 0x00010000, 0x10010000,
0x00000004, 0x10000004, 0x00010004, 0x10010004,
0x20000000, 0x30000000, 0x20010000, 0x30010000,
0x20000004, 0x30000004, 0x20010004, 0x30010004,
0x00100000, 0x10100000, 0x00110000, 0x10110000,
0x00100004, 0x10100004, 0x00110004, 0x10110004,
0x20100000, 0x30100000, 0x20110000, 0x30110000,
0x20100004, 0x30100004, 0x20110004, 0x30110004,
0x00001000, 0x10001000, 0x00011000, 0x10011000,
0x00001004, 0x10001004, 0x00011004, 0x10011004,
0x20001000, 0x30001000, 0x20011000, 0x30011000,
0x20001004, 0x30001004, 0x20011004, 0x30011004,
0x00101000, 0x10101000, 0x00111000, 0x10111000,
0x00101004, 0x10101004, 0x00111004, 0x10111004,
0x20101000, 0x30101000, 0x20111000, 0x30111000,
0x20101004, 0x30101004, 0x20111004, 0x30111004,
);
my @skb5 =
(
# for D bits (numbered as per FIPS 46) 8 9 11 12 13 14
0x00000000, 0x08000000, 0x00000008, 0x08000008,
0x00000400, 0x08000400, 0x00000408, 0x08000408,
0x00020000, 0x08020000, 0x00020008, 0x08020008,
0x00020400, 0x08020400, 0x00020408, 0x08020408,
0x00000001, 0x08000001, 0x00000009, 0x08000009,
0x00000401, 0x08000401, 0x00000409, 0x08000409,
0x00020001, 0x08020001, 0x00020009, 0x08020009,
0x00020401, 0x08020401, 0x00020409, 0x08020409,
0x02000000, 0x0A000000, 0x02000008, 0x0A000008,
0x02000400, 0x0A000400, 0x02000408, 0x0A000408,
0x02020000, 0x0A020000, 0x02020008, 0x0A020008,
0x02020400, 0x0A020400, 0x02020408, 0x0A020408,
0x02000001, 0x0A000001, 0x02000009, 0x0A000009,
0x02000401, 0x0A000401, 0x02000409, 0x0A000409,
0x02020001, 0x0A020001, 0x02020009, 0x0A020009,
0x02020401, 0x0A020401, 0x02020409, 0x0A020409,
);
my @skb6 =
(
# for D bits (numbered as per FIPS 46) 16 17 18 19 20 21
0x00000000, 0x00000100, 0x00080000, 0x00080100,
0x01000000, 0x01000100, 0x01080000, 0x01080100,
0x00000010, 0x00000110, 0x00080010, 0x00080110,
0x01000010, 0x01000110, 0x01080010, 0x01080110,
0x00200000, 0x00200100, 0x00280000, 0x00280100,
0x01200000, 0x01200100, 0x01280000, 0x01280100,
0x00200010, 0x00200110, 0x00280010, 0x00280110,
0x01200010, 0x01200110, 0x01280010, 0x01280110,
0x00000200, 0x00000300, 0x00080200, 0x00080300,
0x01000200, 0x01000300, 0x01080200, 0x01080300,
0x00000210, 0x00000310, 0x00080210, 0x00080310,
0x01000210, 0x01000310, 0x01080210, 0x01080310,
0x00200200, 0x00200300, 0x00280200, 0x00280300,
0x01200200, 0x01200300, 0x01280200, 0x01280300,
0x00200210, 0x00200310, 0x00280210, 0x00280310,
0x01200210, 0x01200310, 0x01280210, 0x01280310,
);
my @skb7 =
(
# for D bits (numbered as per FIPS 46) 22 23 24 25 27 28
0x00000000, 0x04000000, 0x00040000, 0x04040000,
0x00000002, 0x04000002, 0x00040002, 0x04040002,
0x00002000, 0x04002000, 0x00042000, 0x04042000,
0x00002002, 0x04002002, 0x00042002, 0x04042002,
0x00000020, 0x04000020, 0x00040020, 0x04040020,
0x00000022, 0x04000022, 0x00040022, 0x04040022,
0x00002020, 0x04002020, 0x00042020, 0x04042020,
0x00002022, 0x04002022, 0x00042022, 0x04042022,
0x00000800, 0x04000800, 0x00040800, 0x04040800,
0x00000802, 0x04000802, 0x00040802, 0x04040802,
0x00002800, 0x04002800, 0x00042800, 0x04042800,
0x00002802, 0x04002802, 0x00042802, 0x04042802,
0x00000820, 0x04000820, 0x00040820, 0x04040820,
0x00000822, 0x04000822, 0x00040822, 0x04040822,
0x00002820, 0x04002820, 0x00042820, 0x04042820,
0x00002822, 0x04002822, 0x00042822, 0x04042822,
);
my @SPtrans0 =
(
# nibble 0
0x00820200, 0x00020000, 0x80800000, 0x80820200,
0x00800000, 0x80020200, 0x80020000, 0x80800000,
0x80020200, 0x00820200, 0x00820000, 0x80000200,
0x80800200, 0x00800000, 0x00000000, 0x80020000,
0x00020000, 0x80000000, 0x00800200, 0x00020200,
0x80820200, 0x00820000, 0x80000200, 0x00800200,
0x80000000, 0x00000200, 0x00020200, 0x80820000,
0x00000200, 0x80800200, 0x80820000, 0x00000000,
0x00000000, 0x80820200, 0x00800200, 0x80020000,
0x00820200, 0x00020000, 0x80000200, 0x00800200,
0x80820000, 0x00000200, 0x00020200, 0x80800000,
0x80020200, 0x80000000, 0x80800000, 0x00820000,
0x80820200, 0x00020200, 0x00820000, 0x80800200,
0x00800000, 0x80000200, 0x80020000, 0x00000000,
0x00020000, 0x00800000, 0x80800200, 0x00820200,
0x80000000, 0x80820000, 0x00000200, 0x80020200,
);
my @SPtrans1 =
(
# nibble 1
0x10042004, 0x00000000, 0x00042000, 0x10040000,
0x10000004, 0x00002004, 0x10002000, 0x00042000,
0x00002000, 0x10040004, 0x00000004, 0x10002000,
0x00040004, 0x10042000, 0x10040000, 0x00000004,
0x00040000, 0x10002004, 0x10040004, 0x00002000,
0x00042004, 0x10000000, 0x00000000, 0x00040004,
0x10002004, 0x00042004, 0x10042000, 0x10000004,
0x10000000, 0x00040000, 0x00002004, 0x10042004,
0x00040004, 0x10042000, 0x10002000, 0x00042004,
0x10042004, 0x00040004, 0x10000004, 0x00000000,
0x10000000, 0x00002004, 0x00040000, 0x10040004,
0x00002000, 0x10000000, 0x00042004, 0x10002004,
0x10042000, 0x00002000, 0x00000000, 0x10000004,
0x00000004, 0x10042004, 0x00042000, 0x10040000,
0x10040004, 0x00040000, 0x00002004, 0x10002000,
0x10002004, 0x00000004, 0x10040000, 0x00042000,
);
my @SPtrans2 =
(
# nibble 2
0x41000000, 0x01010040, 0x00000040, 0x41000040,
0x40010000, 0x01000000, 0x41000040, 0x00010040,
0x01000040, 0x00010000, 0x01010000, 0x40000000,
0x41010040, 0x40000040, 0x40000000, 0x41010000,
0x00000000, 0x40010000, 0x01010040, 0x00000040,
0x40000040, 0x41010040, 0x00010000, 0x41000000,
0x41010000, 0x01000040, 0x40010040, 0x01010000,
0x00010040, 0x00000000, 0x01000000, 0x40010040,
0x01010040, 0x00000040, 0x40000000, 0x00010000,
0x40000040, 0x40010000, 0x01010000, 0x41000040,
0x00000000, 0x01010040, 0x00010040, 0x41010000,
0x40010000, 0x01000000, 0x41010040, 0x40000000,
0x40010040, 0x41000000, 0x01000000, 0x41010040,
0x00010000, 0x01000040, 0x41000040, 0x00010040,
0x01000040, 0x00000000, 0x41010000, 0x40000040,
0x41000000, 0x40010040, 0x00000040, 0x01010000,
);
my @SPtrans3 =
(
# nibble 3
0x00100402, 0x04000400, 0x00000002, 0x04100402,
0x00000000, 0x04100000, 0x04000402, 0x00100002,
0x04100400, 0x04000002, 0x04000000, 0x00000402,
0x04000002, 0x00100402, 0x00100000, 0x04000000,
0x04100002, 0x00100400, 0x00000400, 0x00000002,
0x00100400, 0x04000402, 0x04100000, 0x00000400,
0x00000402, 0x00000000, 0x00100002, 0x04100400,
0x04000400, 0x04100002, 0x04100402, 0x00100000,
0x04100002, 0x00000402, 0x00100000, 0x04000002,
0x00100400, 0x04000400, 0x00000002, 0x04100000,
0x04000402, 0x00000000, 0x00000400, 0x00100002,
0x00000000, 0x04100002, 0x04100400, 0x00000400,
0x04000000, 0x04100402, 0x00100402, 0x00100000,
0x04100402, 0x00000002, 0x04000400, 0x00100402,
0x00100002, 0x00100400, 0x04100000, 0x04000402,
0x00000402, 0x04000000, 0x04000002, 0x04100400,
);
my @SPtrans4 =
(
# nibble 4
0x02000000, 0x00004000, 0x00000100, 0x02004108,
0x02004008, 0x02000100, 0x00004108, 0x02004000,
0x00004000, 0x00000008, 0x02000008, 0x00004100,
0x02000108, 0x02004008, 0x02004100, 0x00000000,
0x00004100, 0x02000000, 0x00004008, 0x00000108,
0x02000100, 0x00004108, 0x00000000, 0x02000008,
0x00000008, 0x02000108, 0x02004108, 0x00004008,
0x02004000, 0x00000100, 0x00000108, 0x02004100,
0x02004100, 0x02000108, 0x00004008, 0x02004000,
0x00004000, 0x00000008, 0x02000008, 0x02000100,
0x02000000, 0x00004100, 0x02004108, 0x00000000,
0x00004108, 0x02000000, 0x00000100, 0x00004008,
0x02000108, 0x00000100, 0x00000000, 0x02004108,
0x02004008, 0x02004100, 0x00000108, 0x00004000,
0x00004100, 0x02004008, 0x02000100, 0x00000108,
0x00000008, 0x00004108, 0x02004000, 0x02000008,
);
my @SPtrans5 =
(
# nibble 5
0x20000010, 0x00080010, 0x00000000, 0x20080800,
0x00080010, 0x00000800, 0x20000810, 0x00080000,
0x00000810, 0x20080810, 0x00080800, 0x20000000,
0x20000800, 0x20000010, 0x20080000, 0x00080810,
0x00080000, 0x20000810, 0x20080010, 0x00000000,
0x00000800, 0x00000010, 0x20080800, 0x20080010,
0x20080810, 0x20080000, 0x20000000, 0x00000810,
0x00000010, 0x00080800, 0x00080810, 0x20000800,
0x00000810, 0x20000000, 0x20000800, 0x00080810,
0x20080800, 0x00080010, 0x00000000, 0x20000800,
0x20000000, 0x00000800, 0x20080010, 0x00080000,
0x00080010, 0x20080810, 0x00080800, 0x00000010,
0x20080810, 0x00080800, 0x00080000, 0x20000810,
0x20000010, 0x20080000, 0x00080810, 0x00000000,
0x00000800, 0x20000010, 0x20000810, 0x20080800,
0x20080000, 0x00000810, 0x00000010, 0x20080010,
);
my @SPtrans6 =
(
# nibble 6
0x00001000, 0x00000080, 0x00400080, 0x00400001,
0x00401081, 0x00001001, 0x00001080, 0x00000000,
0x00400000, 0x00400081, 0x00000081, 0x00401000,
0x00000001, 0x00401080, 0x00401000, 0x00000081,
0x00400081, 0x00001000, 0x00001001, 0x00401081,
0x00000000, 0x00400080, 0x00400001, 0x00001080,
0x00401001, 0x00001081, 0x00401080, 0x00000001,
0x00001081, 0x00401001, 0x00000080, 0x00400000,
0x00001081, 0x00401000, 0x00401001, 0x00000081,
0x00001000, 0x00000080, 0x00400000, 0x00401001,
0x00400081, 0x00001081, 0x00001080, 0x00000000,
0x00000080, 0x00400001, 0x00000001, 0x00400080,
0x00000000, 0x00400081, 0x00400080, 0x00001080,
0x00000081, 0x00001000, 0x00401081, 0x00400000,
0x00401080, 0x00000001, 0x00001001, 0x00401081,
0x00400001, 0x00401080, 0x00401000, 0x00001001,
);
my @SPtrans7 =
(
# nibble 7
0x08200020, 0x08208000, 0x00008020, 0x00000000,
0x08008000, 0x00200020, 0x08200000, 0x08208020,
0x00000020, 0x08000000, 0x00208000, 0x00008020,
0x00208020, 0x08008020, 0x08000020, 0x08200000,
0x00008000, 0x00208020, 0x00200020, 0x08008000,
0x08208020, 0x08000020, 0x00000000, 0x00208000,
0x08000000, 0x00200000, 0x08008020, 0x08200020,
0x00200000, 0x00008000, 0x08208000, 0x00000020,
0x00200000, 0x00008000, 0x08000020, 0x08208020,
0x00008020, 0x08000000, 0x00000000, 0x00208000,
0x08200020, 0x08008020, 0x08008000, 0x00200020,
0x08208000, 0x00000020, 0x00200020, 0x08008000,
0x08208020, 0x00200000, 0x08200000, 0x08000020,
0x00208000, 0x00008020, 0x08008020, 0x08200000,
0x00000020, 0x08208000, 0x00208020, 0x00000000,
0x08000000, 0x08200020, 0x00008000, 0x00208020
);
my @cov_2char =
(
0x2E, 0x2F, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35,
0x36, 0x37, 0x38, 0x39, 0x41, 0x42, 0x43, 0x44,
0x45, 0x46, 0x47, 0x48, 0x49, 0x4A, 0x4B, 0x4C,
0x4D, 0x4E, 0x4F, 0x50, 0x51, 0x52, 0x53, 0x54,
0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0x61, 0x62,
0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A,
0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, 0x71, 0x72,
0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A
);
sub ushr # only for ints!
{
my ($n, $s) = @_;
$s &= 0x1f;
return( ($n >> $s) & (~0 >> $s) );
}
sub toByte
{
my $value = shift;
$value &= 0xff;
$value = - ((~$value & 0xff) + 1) if ($value & 0x80);
return $value;
}
sub toInt
{
my $value = shift;
$value = - ((~$value & 0xffffffff) + 1) if ($value & 0x80000000);
return $value;
}
sub byteToUnsigned # int byteToUnsigned(byte b)
{
my $value = shift;
return( $value >= 0 ? $value : $value + 256 );
}
sub fourBytesToInt # int fourBytesToInt(byte b[], int offset)
{
my ($b, $offset) = @_;
my $value;
$value = byteToUnsigned($b->[$offset++]);
$value |= (byteToUnsigned($b->[$offset++]) << 8);
$value |= (byteToUnsigned($b->[$offset++]) << 16);
$value |= (byteToUnsigned($b->[$offset++]) << 24);
return toInt($value);
}
sub intToFourBytes # void intToFourBytes(int iValue, byte b[], int offset)
{
my ($iValue, $b, $offset) = @_;
$b->[$offset++] = toByte(ushr($iValue, 0) & 0xff);
$b->[$offset++] = toByte(ushr($iValue, 8) & 0xff);
$b->[$offset++] = toByte(ushr($iValue,16) & 0xff);
$b->[$offset++] = toByte(ushr($iValue,24) & 0xff);
return undef;
}
sub PERM_OP # void PERM_OP(int a, int b, int n, int m, int results[])
{
my ($a, $b, $n, $m, $results) = @_;
my $t;
$t = (ushr($a,$n) ^ $b) & $m;
$a ^= $t << $n;
$b ^= $t;
$results->[0] = toInt($a);
$results->[1] = toInt($b);
return undef;
}
sub HPERM_OP # void HPERM_OP(int a, int n, int m)
{
my ($a, $n, $m) = @_;
my $t;
$t = (($a << (16 - $n)) ^ $a) & $m;
$a = $a ^ $t ^ ushr($t, 16 - $n);
return toInt($a);
}
sub des_set_key # int [] des_set_key(byte key[])
{
my ($key) = @_;
my @schedule; $#schedule = $ITERATIONS * 2 -1;
my $c = fourBytesToInt($key, 0);
my $d = fourBytesToInt($key, 4);
my @results; $#results = 1;
PERM_OP($d, $c, 4, 0x0f0f0f0f, \@results);
$d = $results[0]; $c = $results[1];
$c = HPERM_OP($c, -2, 0xcccc0000);
$d = HPERM_OP($d, -2, 0xcccc0000);
PERM_OP($d, $c, 1, 0x55555555, \@results);
$d = $results[0]; $c = $results[1];
PERM_OP($c, $d, 8, 0x00ff00ff, \@results);
$c = $results[0]; $d = $results[1];
PERM_OP($d, $c, 1, 0x55555555, \@results);
$d = $results[0]; $c = $results[1];
$d = ( (($d & 0x000000ff) << 16) | ($d & 0x0000ff00) |
ushr($d & 0x00ff0000, 16) | ushr($c & 0xf0000000, 4));
$c &= 0x0fffffff;
my ($s, $t);
my ($i, $j);
$j = 0;
for($i = 0; $i < $ITERATIONS; $i++)
{
if($shifts2[$i])
{
$c = ushr($c, 2) | ($c << 26);
$d = ushr($d, 2) | ($d << 26);
}
else
{
$c = ushr($c, 1) | ($c << 27);
$d = ushr($d, 1) | ($d << 27);
}
$c &= 0x0fffffff;
$d &= 0x0fffffff;
$s = $skb0[ ($c ) & 0x3f ]|
$skb1[(ushr($c, 6) & 0x03) | (ushr($c, 7) & 0x3c)]|
$skb2[(ushr($c,13) & 0x0f) | (ushr($c,14) & 0x30)]|
$skb3[(ushr($c,20) & 0x01) | (ushr($c,21) & 0x06) |
(ushr($c,22) & 0x38)];
$t = $skb4[ ($d ) & 0x3f ]|
$skb5[(ushr($d, 7) & 0x03) | (ushr($d, 8) & 0x3c) ]|
$skb6[ ushr($d,15) & 0x3f ]|
$skb7[(ushr($d,21) & 0x0f) | (ushr($d,22) & 0x30)];
$schedule[$j++] = ( ($t << 16) | ($s & 0x0000ffff)) & 0xffffffff;
$s = (ushr($s, 16) | ($t & 0xffff0000));
$s = ($s << 4) | ushr($s,28);
$schedule[$j++] = $s & 0xffffffff;
}
return \@schedule;
}
sub D_ENCRYPT # int D_ENCRYPT(int L, int R, int S, int E0, int E1, int s[])
{
my ($L, $R, $S, $E0, $E1, $s) = @_;
my ($t, $u, $v);
$v = $R ^ ushr($R,16);
$u = $v & $E0;
$v = $v & $E1;
$u = ($u ^ ($u << 16)) ^ $R ^ $s->[$S];
$t = ($v ^ ($v << 16)) ^ $R ^ $s->[$S + 1];
$t = ushr($t, 4) | ($t << 28);
$L ^= $SPtrans1[ ($t ) & 0x3f] |
$SPtrans3[ushr($t, 8) & 0x3f] |
$SPtrans5[ushr($t, 16) & 0x3f] |
$SPtrans7[ushr($t, 24) & 0x3f] |
$SPtrans0[ ($u ) & 0x3f] |
$SPtrans2[ushr($u, 8) & 0x3f] |
$SPtrans4[ushr($u, 16) & 0x3f] |
$SPtrans6[ushr($u, 24) & 0x3f];
return $L;
}
sub body # int [] body(int schedule[], int Eswap0, int Eswap1)
{
my ($schedule, $Eswap0, $Eswap1) = @_;
my $left = 0;
my $right = 0;
my $t = 0;
my ($i, $j);
for($j = 0; $j < 25; $j++)
{
for($i = 0; $i < $ITERATIONS * 2; $i += 4)
{
$left = D_ENCRYPT($left, $right, $i, $Eswap0, $Eswap1, $schedule);
$right = D_ENCRYPT($right, $left, $i + 2, $Eswap0, $Eswap1, $schedule);
}
$t = $left;
$left = $right;
$right = $t;
}
$t = $right;
$right = ushr($left, 1) | ($left << 31);
$left = ushr($t , 1) | ($t << 31);
$left &= 0xffffffff;
$right &= 0xffffffff;
my @results; $#results = 1;
PERM_OP($right, $left, 1, 0x55555555, \@results);
$right = $results[0]; $left = $results[1];
PERM_OP($left, $right, 8, 0x00ff00ff, \@results);
$left = $results[0]; $right = $results[1];
PERM_OP($right, $left, 2, 0x33333333, \@results);
$right = $results[0]; $left = $results[1];
PERM_OP($left, $right, 16, 0x0000ffff, \@results);
$left = $results[0]; $right = $results[1];
PERM_OP($right, $left, 4, 0x0f0f0f0f, \@results);
$right = $results[0]; $left = $results[1];
my @out; $#out = 1;
$out[0] = $left; $out[1] = $right;
return \@out;
}
sub crypt # String crypt(String salt, String original)
{
my ($salt, $original) = @_;
while(length($salt) < 2)
{
$salt .= 'A';
}
my $buffer = '';
substr($buffer,0,2) = substr($salt,0,2);
my $Eswap0 = $con_salt[ord(substr($salt,0,1))];
my $Eswap1 = $con_salt[ord(substr($salt,1,1))] << 4;
my @key; $#key = 7;
for(0 .. @key)
{
$key[$_] = 0;
}
my $i;
my @iChar = map { ord($_) << 1 } split(//, $original);
for($i = 0; $i < @key && $i < @iChar; $i++)
{
$key[$i] = toByte($iChar[$i]);
}
my $schedule = des_set_key(\@key);
my $out = body($schedule, $Eswap0, $Eswap1);
my @b; $#b = 8;
intToFourBytes($out->[0], \@b, 0);
intToFourBytes($out->[1], \@b, 4);
$b[8] = 0;
my ($j, $c, $y, $u);
for($i = 2, $y = 0, $u = 0x80; $i < 13; $i++)
{
for($j = 0, $c = 0; $j < 6; $j++)
{
$c <<= 1;
$c |= 1 if (($b[$y] & $u) != 0);
$u >>= 1;
if($u == 0)
{
$y++;
$u = 0x80;
}
}
$buffer .= chr($cov_2char[$c]);
}
return $buffer;
}
1;
--
| Martin Vorlaender | VMS & WNT programmer
Ceterum censeo | work: mv@pdv-systeme.de
Redmondem delendam esse. | http://www.pdv-systeme.de/users/martinv/
| home: martin@radiogaga.harz.de
------------------------------
Date: Sat, 20 Dec 1997 21:45:34 -0600
From: tadmc@metronet.com (Tad McClellan)
Subject: Re: Beginner HELP needed :)
Message-Id: <uc3i76.sa3.ln@localhost>
[ Two administrative notes if you wish to get the most out of Usenet
(I eventually will get to answering your question):
1) Do your best to ask in the newsgroup most closely related
to your question
CGI questions are more likely to be answered in the CGI newsgroup:
comp.infosystems.www.authoring.cgi
If you find that you _need_ to tell us that you are using Perl
in a CGI environment, then that is a good clue that it is
probably not a Perl question.
2) This is a pretty high-traffic newsgroup. I doubt if many people
read every article here. Wanna know how they chose which to read
and which to skip?
They see if the Subject: is of interest to them.
They cannot tell what your article is about, because you did
not take the time to put the real subject in your Subject:
Subject: blank line and CGI
Subject: separating header and data
Subject: contained no blank line separating the header and data
Any of those would give you a _much_ better chance of getting
your question answered, or at least read.
]
Terry McC (terrymcc@buffnet.net) wrote:
: -
: Hi,
: I have a cool "writing on the wall" program that I can not
: get to work on my NT Server :(
: I keep on getting the error telling me
: "contained no blank line separating the header and data
: most likely a broken CGI program"
: I have looked at the wall.pl and there is a blank line there.
^^^^^^^^^^^^^
Yes, but you said you are a beginner.
Wouldn't you like to have someone else have a look at it too?
One of us, maybe?
Troubleshooting code that you cannot see is Very Hard ;-)
: I have spent several hours on this SIMPLE problem and looked through all
^^^^^^^^^^^^^
Ouch! What a grievous waste of time.
Here. Let me tell you how to get the answer to most of your questions
in a few *minutes*.
: my book and I still can NOT figure it out :(
^^^^^^^
But surely you don't view a single book as your only resource?
Either the Perl FAQ or the World Wide Web could get you the answer
to your question in less than 10 minutes.
-----
Perl FAQ, part 9:
"My CGI script runs from the command line but not the browser.
Can you help me fix it?"
gives 5 URLs for information helpful to new CGI programmers. The
answer to your question is in more than one of those.
-----
World Wide Web
http://www.dejanews.com is a searchable archive of Usenet postings.
It is likely that someone else has asked about that particular
error message.
Filtered to any of the comp.infosystems.www* newsgroups, a
search for "contained no blank line" (quotes and all), taken
exactly from your error message, finds 21 hits.
I saw the answer to your question in several of the first five...
: I'm sure anyone can fix this simple error... Please help me.
Well, even though it is off topic for this newsgroup, I'll go ahead
and answer your CGI question (see, I eventually got to actually
answering what you asked ;-)
But just this one time!
You don't need a blank line in your _script_.
You need a blank line in the _output_ of your script, to mark
the end of the header records. Probably in a print statement
somewhere, but I can't really tell because you did not share
your code with us.
: Thanks in advance,
You're welcome.
: PS: Please reply in email if you are willing to help me
But then only you will benefit from the answer. That is why there
_is_ a newsgroup, so that many folks can find answers.
Let's not be stingy with help and advice.
I prefer to answer only here, where others can see it too. Sorry.
--
Tad McClellan SGML Consulting
tadmc@metronet.com Perl programming
Fort Worth, Texas
------------------------------
Date: Sun, 21 Dec 1997 13:21:33 +0100
From: Aragorn <mbijlsma.nospam@xs4all.nl>
Subject: calling two arrays in a function as variables
Message-Id: <349D09CD.FFC2D992@xs4all.nl>
Hi,
I've got a problem calling two lists or arrays into a function. When I
call them inside the function using (@foo, %bar) = @_; perl tends to
assign all elements - both arrays - to the first one, leaving the second
one empty. Something like this:
sub RequireFields {
local(%array, @list) = @_;
if (!@list) {die "RequireFields function error: your list contains
no elements\n";}
elsif (!%array) {die "RequireFields function error: your array
contains no elements\n";}
foreach (@list) {
if (!$array{$_}) {die "$_ is not present in your array\n";}
}
}
won't work.
Is there any special syntax forcing perl to keep the two devided, any
trick to get the arrays back in line, just.. anything that will work? :)
Thanks in advance,
Melle Bijlsma
--
get the <nospam> out of my email for the correct e-mail adress.
------------------------------
Date: Sat, 20 Dec 1997 22:16:29 -0600
From: tadmc@metronet.com (Tad McClellan)
Subject: Re: does ne1 know...
Message-Id: <t65i76.nd3.ln@localhost>
MrPc (tjbiuso@redrose.net) wrote:
: where can i get source code for a keyword search engine?
If you can come up with good keywords, you could enter those
keywords into a search engine and likely find a keyword search engine.
;-)
--
Tad McClellan SGML Consulting
tadmc@metronet.com Perl programming
Fort Worth, Texas
------------------------------
Date: 21 Dec 1997 13:27:12 GMT
From: joc@netaxs.com (Joe Casadonte)
Subject: Dynamic s/// vs. s///i?
Message-Id: <67j5fg$8tt@netaxs.com>
I am trying to write a script that will help non-Perl users get some of
the power of Perl search and replace. I would like to write a single
match (m//) and substitute (s///) statement that can handle things
like word-boundaries (or not) or case insensitivity (or not), all
depending on the users immediate needs. Is there an easy way without
using eval?
Regards,
joe
joc@netaxs.com
------------------------------------------------------------------------------
Llama Fresh Farms => http://www.netaxs.com/~joc
Gay Media Resource List => http://www.netaxs.com/~joc/gaymedia.html
Perl for Win32 => http://www.netaxs.com/~joc/perlwin32.html
PerlRing Homepage => http://www.netaxs.com/~joc/perlring.html
------------------------------------------------------------------------------
Live Free, that's the message!
------------------------------------------------------------------------------
------------------------------
Date: Sat, 20 Dec 1997 22:09:47 -0600
From: tadmc@metronet.com (Tad McClellan)
Subject: Re: How do I Access the Integer Returned by a C Program?
Message-Id: <bq4i76.nd3.ln@localhost>
Kevin M Simonson (simonsen_nospam@skopen.dseg.ti.com) wrote:
: I've written a little C program that just subtracts two from the num-
: ber of its arguments and then returns that value to its calling environ-
^^^^^^^^^^^^^^^
: ment. I'm running this on a Unix platform, so this value gets put into the
^^^^
: "status" variable as illustrated:
^^^^^^^^^^^^^^^^^
So $status is an _environment variable_ in the shell that you launch
the below perl script from?
If so, then see below.
If so, then that seems a strange way to return status information.
Why not just use the exit value from executing the C program?
If not, then I don't understand the question ;-)
: I need to get some information from a C program to the "perl" script
: that is going to call it, so I decided to test this out with a "perl"
: script that calls "ReturnValue". Here's the one I wrote:
:
: #!/usr/local/bin/perl
If you had asked perl to help you, it would have. Change this one
line and see the stderr output:
#!/usr/local/bin/perl -w
: print "ReturnValue @ARGV\n";
: print `ReturnValue @ARGV`;
: if ($status == 0)
if ($ENV{status} == 0)
: { print "Status was zero.\n";
: }
: else
: { print "Status was $status.\n";
{ print "Status was $ENV{status}.\n";
--
Tad McClellan SGML Consulting
tadmc@metronet.com Perl programming
Fort Worth, Texas
------------------------------
Date: Sun, 21 Dec 1997 13:39:55 +0200
From: Ophir Yoktan <ophiry@agentsoft.com>
Subject: redirection on win95
Message-Id: <349D000A.6E1117F7@agentsoft.com>
I'm trying to run a program and capture it output.
i tried
system "prog > log file"
and `prog > log file`
but they dont work - does anybody how it can be done?
please CC to my e-mail
-----------------------------
Ophir Yoktan
ophiry@agentsoft.com
http://www.huji.ac.il/~ophiry
"It's not a bug, It's a feature"
(old Microsoftian proverb)
------------------------------
Date: Sun, 21 Dec 1997 07:00:15 -0500
From: comdog@computerdog.com (brian d foy)
Subject: Re: Script calling another script
Message-Id: <67ivvi$ro@bgtnsc02.worldnet.att.net>
In article <01bd0bf2$bf9ef9e0$f0d2f3cd@www2.edp.net>, "Thomas Paine"
<paineta@edp.net> wrote:
> Can't I use the system() and /or exec() functions for this?
what happened when you tried it?
--
brian d foy <http://computerdog.com>
#!/usr/bin/perl
$_=q|osyrNewkecnaYhe.mlorsePptMskurj|;s;[NY.PM]; ;g;local$\=
qq$\n$;@pm=split//;while($NY=pop @pm){$pm.=$NY;$ny.=pop @pm}
$pm=join'',reverse($ny,$pm);open(NY,'>&STDOUT');print NY $pm
------------------------------
Date: Sun, 21 Dec 1997 12:38:56 +0100
From: Marc de GOUTTES <mdgoutte@asi.fr>
Subject: Re: unshift, @INC, require???
Message-Id: <349CFFD0.12C7@asi.fr>
Just one question : does it work when you execute your script invoking
perl with '-I' argument, giving path to your personal directory ?
Marc
------------------------------
Date: Sun, 21 Dec 1997 06:54:46 -0500
From: comdog@computerdog.com (brian d foy)
Subject: Re: Verifying a URL
Message-Id: <67ivl9$ro@bgtnsc02.worldnet.att.net>
In article <Pine.GSO.3.96.971221000459.4324k-100000@user2.teleport.com>,
Tom Phoenix <rootbeer@teleport.com> wrote:
> On Sun, 21 Dec 1997, psullivan wrote:
>
> > I would like to check the validity of the URL to make sure that it
> > exists. How would I do this in perl?
>
> Almost certainly, you'll want to use the LWP module, and a HEAD request.
> Hope this helps!
let's remember that one might need to fall back to the GET method if
HEAD doesn't work.
--
brian d foy <http://computerdog.com>
#!/usr/bin/perl
$_=q|osyrNewkecnaYhe.mlorsePptMskurj|;s;[NY.PM]; ;g;local$\=
qq$\n$;@pm=split//;while($NY=pop @pm){$pm.=$NY;$ny.=pop @pm}
$pm=join'',reverse($ny,$pm);open(NY,'>&STDOUT');print NY $pm
------------------------------
Date: Sun, 21 Dec 1997 10:26:51 +0000
From: tony buono <tony@buono.demon.co.uk>
Subject: Wanna get the Week Day for a specified date
Message-Id: <349CEEEB.9DCA64D0@buono.demon.co.uk>
Okay, I admit that I am a newbie, but I have some experience
I am using the timelocal.pl to get Todays week day, time date and Year
with no problem using this:
$the_first = 1;
$now_string= localtime;
$if ($now_string =~ m/(\w+)( +)(\w+)( +)(\w+)( +)(\d+)\:(\d+)\:(\d+)(
+)(\d+)$/)
{
($wkday,$month,$date,$year) = ($1,$3,$5,$11);
$mon_start = &timegm(undef,undef,undef,$the_first,$month,$year);
}
Okay, that all works for me (once I changed the timelocal to timegm that
is). When all is done, I get the proper day of the weel for the first
day of the month. I then throw it through a script that will output a
calendar for THIS month where the first of the month is on the proper
week day...
Now what I want to do is make $month more of a variable so that Any
month that I choose will come up with the proper 1st = Weekday
relationship. I am getting the month from the title of a file (i.e.
Decfile.txt) which I then throw into a substr to get "Dec"
open (TEXTFILE, "$FORM{url}/$next_element};
$calMonth = substr($next_element, 0,3);
$mon_start = &timegm(undef,undef,undef,$the_first,$calMonth,$year);
But this throws my server into some kinda loop that is really p*ssing of
the guys in charge.
I am running this as a cgi, so I know this should be elsewhere, but it
really is a question about timelocal.pl... and I am more than willing to
trash this whole series of statements if someone knows an easier way to
equate the weekday and date of the month (I prefer to use 0 = Sunday, 1
= monday...)
Thanks for reading!!
TOny
tony@buono.demon.co.uk
$month =
So,
------------------------------
Date: 21 Dec 1997 08:08:25 GMT
From: seebs@plethora.net (Peter Seebach)
Subject: Re: Which language pays most 17457 -- C++ vs. Java?
Message-Id: <67iipp$ktj$1@darla.visi.com>
In article <ObfZp4YD9GA.296@upnetnews02.moswest.msn.net>,
William J. Leary Jr. <Bill_Leary@msn.com> wrote:
>Not that I've ever noticed. I frequently use C compilers to target embedded
>systems.
Then you're using "freestanding environments", which are a separate language.
The library is, indeed, part of the hosted environment form of C.
-s
--
seebs@plethora.net -- I am not speaking for my employer. Copyright '97
All rights reserved. This was not sent by my cat. C and Unix wizard -
send mail for help, or send money for a consultation. Visit my new ISP
<URL:http://www.plethora.net/> --- More Net, Less Spam! Plethora . Net
------------------------------
Date: 21 Dec 1997 08:09:57 GMT
From: seebs@plethora.net (Peter Seebach)
Subject: Re: Which language pays most 17457 -- C++ vs. Java?
Message-Id: <67iisl$ktj$2@darla.visi.com>
In article <#vJ8k2aD9GA.169@upnetnews03>,
William J. Leary Jr. <Bill_Leary@msn.com> wrote:
>Yes, very good. THAT makes a lot of sense, and I've seen that myself.
>Still, that's the environment, not the langauge specification for C.
Except that it is in the language specification for C; C defines what
a hosted environment is, including the entire library, and, in a hosted
environment, there is no reason at all to assume that you can replace or
affect the standard library in any way, however trivial.
Note followups.
-s
--
seebs@plethora.net -- I am not speaking for my employer. Copyright '97
All rights reserved. This was not sent by my cat. C and Unix wizard -
send mail for help, or send money for a consultation. Visit my new ISP
<URL:http://www.plethora.net/> --- More Net, Less Spam! Plethora . Net
------------------------------
Date: 8 Mar 97 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 8 Mar 97)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V8 Issue 1517
**************************************
