[13969] in Perl-Users-Digest
Perl-Users Digest, Issue: 1380 Volume: 9
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Nov 15 10:05:27 1999
Date: Mon, 15 Nov 1999 06:05:09 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <942674709-v9-i1380@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Mon, 15 Nov 1999 Volume: 9 Number: 1380
Today's topics:
$variable == null?? <abel.almazan@ogilvyinteractive.es>
Case sensitive command line options <Soeren.Gehrke@eed.ericsson.se>
Re: Case sensitive command line options <mark.bluemelNOmaSPAM@siemens.co.uk.invalid>
Re: Case sensitive command line options (Johan Vromans)
CGI + POSIX modules. (Dr. Smith)
date_to_ticks tilmanglotzner@my-deja.com
Re: date_to_ticks <mark.bluemelNOmaSPAM@siemens.co.uk.invalid>
DBI questions (memory, signals) (Jani Lahti)
Re: Generating pi (David Cantrell)
Re: Help with Stoopid Nutscrape (Netscape) (H. Merijn Brand)
Re: Help with Stoopid Nutscrape (Netscape) (Abigail)
Re: help <mark.bluemelNOmaSPAM@siemens.co.uk.invalid>
How can I test CGI-Perl locally on PC ?? <aalwi@waumail.com>
Re: How to Convert a string to a integer! (Abigail)
Netscape messenger or other mail client accessable, Win <ter@my-deja.com>
pb calling external command in CGI <cbrunet@wanadoo.fr>
Removing all combinations of spaces/tabs at end of stri tony_123@my-deja.com
Re: Sample TCP/IP Client / Server routine in NT (Lars Gregersen)
Test of ODBC by a perl script <n.vincentNOn.SPAM@cross-systems.com.invalid>
Unexpected error in array <mfoster@spots.ab.ca>
Using files <Andrew_Longworth@bigfoot.com>
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Mon, 15 Nov 1999 13:23:27 +0100
From: Abel =?iso-8859-1?Q?Almaz=E1n?= <abel.almazan@ogilvyinteractive.es>
Subject: $variable == null??
Message-Id: <382FFB3F.66E9987B@ogilvyinteractive.es>
How can i know if a var is null??
syntax to do that
thanx
------------------------------
Date: Mon, 15 Nov 1999 13:24:14 +0100
From: Soeren Gehrke <Soeren.Gehrke@eed.ericsson.se>
Subject: Case sensitive command line options
Message-Id: <382FFB6D.3ADA0825@eed.ericsson.se>
Hi,
executing the perl script "CmdOptions":
#!/usr/local/bin/perl -w
use Getopt::Long;
$RetGetOptions = GetOptions("l=s@", "L=s@");
print "RetGetOptions = ", $RetGetOptions, "\n";
print "opt_l = ", join(' ', @opt_l), "\n";
print "opt_L = ", join(' ', @opt_L), "\n";
like this:
CmdOptions -l 1 -L 2
I get the following result:
Name "main::opt_L" used only once: possible typo at CmdOptions line 6.
Name "main::opt_l" used only once: possible typo at CmdOptions line 5.
RetGetOptions = 1
opt_l =
opt_L = 1 2
Why the package "Getopt::Long" doesn't distinguish between the "-l" and
the "-L" command line options?
Cheers
Soeren
------------------------------
Date: Mon, 15 Nov 1999 04:34:13 -0800
From: Mark Bluemel <mark.bluemelNOmaSPAM@siemens.co.uk.invalid>
Subject: Re: Case sensitive command line options
Message-Id: <000b8d9b.1301c306@usw-ex0101-006.remarq.com>
In article <382FFB6D.3ADA0825@eed.ericsson.se>, Soeren Gehrke
<Soeren.Gehrke@eed.ericsson.se> wrote:
[Snip]
> Why the package "Getopt::Long" doesn't distinguish between the
> "-l" and
> the "-L" command line options?
Because, as the documentation tells you, the "ignore_case"
configuration option is set by default. You need to use
Getopt::Long:Configure to reset it.
--
Mark Bluemel
* Sent from RemarQ http://www.remarq.com The Internet's Discussion Network *
The fastest and easiest way to search and participate in Usenet - Free!
------------------------------
Date: 15 Nov 1999 13:46:19 +0100
From: JVromans@Squirrel.nl (Johan Vromans)
Subject: Re: Case sensitive command line options
Message-Id: <wl366z3j52c.fsf@plume.nl.compuware.com>
Soeren Gehrke <Soeren.Gehrke@eed.ericsson.se> writes:
> Why the package "Getopt::Long" doesn't distinguish between the "-l" and
> the "-L" command line options?
It doesn distinguish case by default.
You can issue
Getopt::Long::Configure ("no_ignore_case");
before the call to GetOptions to obtain the desired effect.
BTW, to get rid of the warnings, you can use:
my @opt_L = ();
my @opt_l = ();
$RetGetOptions = GetOptions("l=s" => \@opt_l, "L=s" => \@opt_L);
Note that you do not need to add the @ after =s, since the destination
is now explicitly designated as an array.
-- Johan
Author and maintainer of Getopt::Long
------------------------------
Date: Mon, 15 Nov 1999 10:39:45 GMT
From: mosher@amdocs.com (Dr. Smith)
Subject: CGI + POSIX modules.
Message-Id: <382fe2dd.98081293@sointnews>
Hi,
I run a PERL script (on AIX) which includes calls for CGI + POSIX
modules.
Where can I get these modules? I'm using PERL 5.3.
Thanks
------------------------------
Date: Mon, 15 Nov 1999 12:22:36 GMT
From: tilmanglotzner@my-deja.com
Subject: date_to_ticks
Message-Id: <80otua$stf$1@nnrp1.deja.com>
Hi,
I need and inverse operation to localtime whichs converts a time given
$Year,$month,$day,$hour,$min,$sec) back to ticks. I did not found a
function in perl which does that. Can it be done anyway ?
Thanks,
Tilman
Sent via Deja.com http://www.deja.com/
Before you buy.
------------------------------
Date: Mon, 15 Nov 1999 04:39:58 -0800
From: Mark Bluemel <mark.bluemelNOmaSPAM@siemens.co.uk.invalid>
Subject: Re: date_to_ticks
Message-Id: <0a0133f8.1482725a@usw-ex0101-006.remarq.com>
In article <80otua$stf$1@nnrp1.deja.com>, tilmanglotzner@my-deja.com
wrote:
> Hi,
> I need and inverse operation to localtime whichs converts a time
> given
> $Year,$month,$day,$hour,$min,$sec) back to ticks. I did not found a
> function in perl which does that. Can it be done anyway ?
The FAQ (which is in the distribution) is, as ever, your friend here -
and more friendly than some of us are likely to be when asked the same
questions again and again...
In perlfaq4 it says:-
"How can I take a string and turn it into epoch seconds?
If it's a regular enough string that it always has the same format, you
can split it up and pass the parts to timelocal in the standard
Time::Local module. Otherwise, you should look into the Date::Calc and
Date::Manip modules from CPAN."
Is that complete, explicit and clear enough?
--
Mark Bluemel
* Sent from RemarQ http://www.remarq.com The Internet's Discussion Network *
The fastest and easiest way to search and participate in Usenet - Free!
------------------------------
Date: 15 Nov 1999 12:04:07 GMT
From: ace@XX-iki.fi (Jani Lahti)
Subject: DBI questions (memory, signals)
Message-Id: <80osrn$lkd$1@baker.cc.tut.fi>
Although Tom Christiansen recently posted a bit a faq which re-
minded me that perl happily uses more memory to speed up things,
I'd like some help.
I'm running perl version 5.004_04 built for sun4-solaris, DBI
version 1.13 and DBD::Oracle (the version which was out by the
same time than DBI 1.13).
When I open a DBI connection to Oracle, my script grows by 3MB. I
understand it's because some more script data is being utilized and
buffers reserved. It's just that I think 3MB is a bit too much.
(Resident size of one process is mere 11-14 percent smaller than
the actual size of one process.) Is there any ways to control how
memory is used within DBI/DBD?
There's potentially a couple of dozen of different 24/7-scripts
with open DB connections running at any given time on one system,
so even one MB per script saved would free quite a bit of memory.
Most of the scripts wouldn't mind a bit slower execution.
I also noticed that previously I could stop the scripts with ^C,
but now when DBI is in use, it seems to trap signals and decides
not to care about them. Can I override this behaviour?
(Should some one reply by mail, please notice the extra X's in
the from address)
//jani
--
jani.lahti@XX-iki.fi -- http://www.iki.fi/jani.lahti/ -- 050 345 0030
Todelliset kunniamerkit näkyvät vain saunassa. -- T.Rautavaara
------------------------------
Date: Mon, 15 Nov 1999 10:37:22 GMT
From: NukeEmUp@ThePentagon.com (David Cantrell)
Subject: Re: Generating pi
Message-Id: <382fe248.403889282@10.0.0.155>
On Fri, 12 Nov 1999 22:11:00 -0500, "Steve Protopapas"
<steve@corp.airmedia.com> said:
>Yanick Champoux <yanick1@sympatico.ca> wrote in message
>news:QX0X3.50774$up3.78461@news21.bellglobal.com...
>
>> I know! I got it! I bet there is no module to compute '1' to
>> an arbitrary precision. ;)
>
>Here's an easy one too: e^(pi*i)
Evil :-)
--
David Cantrell, part-time Unix/perl/SQL/java techie
full-time chef/musician/homebrewer
http://www.ThePentagon.com/NukeEmUp
------------------------------
Date: 15 Nov 1999 10:03:35 GMT
From: h.m.brand@hccnet.nl (H. Merijn Brand)
Subject: Re: Help with Stoopid Nutscrape (Netscape)
Message-Id: <8E7F734DFMerijn@192.0.1.5>
This post is off-topic!
>
>Make sure the HTML is correct.
>
And do not use M$'s IE
>Erik
Hoi Erik, hoe gaat het met je. Leuk je hier weer tegen te komen.
Waar werk je nu. Hoe is het om getrouwd te zijn?
--
H.Merijn Brand
using perl5.005.03 on HP-UX 10.20, HP-UX 11.00, AIX 4.2, AIX 4.3,
DEC OSF/1 4.0 and WinNT 4.0, often with perlTk 800.015
ftp://ftp.funet.fi:/pub/languages/perl/CPAN/authors/id/H/HM/HMBRAND/
Member of Amsterdam Perl Mongers (http://www.amsterdam.pm.org/)
------------------------------
Date: 15 Nov 1999 05:20:09 -0600
From: abigail@delanet.com (Abigail)
Subject: Re: Help with Stoopid Nutscrape (Netscape)
Message-Id: <slrn82vr9q.cvu.abigail@alexandra.delanet.com>
H. Merijn Brand (h.m.brand@hccnet.nl) wrote on MMCCLXVII September
MCMXCIII in <URL:news:8E7F734DFMerijn@192.0.1.5>:
:: This post is off-topic!
Then don't post it here.
:: Hoi Erik, hoe gaat het met je. Leuk je hier weer tegen te komen.
::
:: using perl5.005.03 on HP-UX 10.20, HP-UX 11.00, AIX 4.2, AIX 4.3,
:: DEC OSF/1 4.0 and WinNT 4.0, often with perlTk 800.015
You're using at least 6 different platforms. At least one of them
has mail, hasn't it?
Abigail
--
sub _'_{$_'_=~s/$a/$_/}map{$$_=$Z++}Y,a..z,A..X;*{($_::_=sprintf+q=%X==>"$A$Y".
"$b$r$T$u")=~s~0~O~g;map+_::_,U=>T=>L=>$Z;$_::_}=*_;sub _{print+/.*::(.*)/s}
*_'_=*{chr($b*$e)};*__=*{chr(1<<$e)};
_::_(r(e(k(c(a(H(__(l(r(e(P(__(r(e(h(t(o(n(a(__(t(us(J())))))))))))))))))))))))
-----------== Posted via Newsfeeds.Com, Uncensored Usenet News ==----------
http://www.newsfeeds.com The Largest Usenet Servers in the World!
------== Over 73,000 Newsgroups - Including Dedicated Binaries Servers ==-----
------------------------------
Date: Mon, 15 Nov 1999 04:04:50 -0800
From: Mark Bluemel <mark.bluemelNOmaSPAM@siemens.co.uk.invalid>
Subject: Re: help
Message-Id: <11f733ec.0b57544c@usw-ex0101-006.remarq.com>
In article <382FF5A7.25E37635@bt.com>, Tim Mann <tim.mann@bt.com> wrote:
> Hi Folks,
> Can anyone show me how to get form input from a web page to a
> file on a
> unix system.
> Cheers,
> Tim..
Tim,
"help" is not a very precise subject for your posting. The content of
your posting is not much more informative, but the short answer is
"CGI".
If I assume you intend to do this in Perl - after all you posted to the
Perl newsgroup - then there are a whole lot of questions to be
answered:-
1) Do you have Perl installed on the system? If not, you'll have to get
it and probably build it...
2) Do you know anything about Perl? If not, you need to learn -
probably using one of the books recommended at www.perl.com - where you
will also find the Frequently Asked Questions and pointers to tutorials
etc.
3) Do you have a webserver installed? Do you know which one? Do you
know how configure it to support CGI (Common GateWay Interface)
programs?
4) Once you've got through all that, I think you'll find some sample
programs using the CGI module (what's a module? You'd better do some
reading!) in the Perl distribution.
HTH
--
Mark Bluemel
* Sent from RemarQ http://www.remarq.com The Internet's Discussion Network *
The fastest and easiest way to search and participate in Usenet - Free!
------------------------------
Date: 15 Nov 1999 19:39:52 +0800
From: "Azrul Alwi" <aalwi@waumail.com>
Subject: How can I test CGI-Perl locally on PC ??
Message-Id: <01bf2f5d$0ed57f40$0100007f@noriyanti>
Is there anyway to test CGI-Perl locally on PC before uploading it ..?
------------------------------
Date: 15 Nov 1999 05:32:18 -0600
From: abigail@delanet.com (Abigail)
Subject: Re: How to Convert a string to a integer!
Message-Id: <slrn82vs0i.cvu.abigail@alexandra.delanet.com>
Benjamin Gu (Benjamin_Gu@email.mot.com) wrote on MMCCLXVII September
MCMXCIII in <URL:news:382FD359.D050BB1A@email.mot.com>:
&& Dear All,
&&
&& I am implementing a permutation
&& algorithm with Perl, i got a trouble
&& when i was trying to sort one of my
&& arrays. Specifically i have an
&& array like this,
&& "m:x1_1:_vert#id",
&& Wm:x2_1:_vert#id" ....
&& "m:x1_12:_vert#id"), what i was
&& trying to do is to arrange these
&& strings according to the 2 numbers.
Do
you
really
have
to
cram
every-
thing
into
the
left
margin?
People
don't
like
lines
with
more
than
80
chars
but
tiny
lines
are
silly
too.
&& So i developed some code as below:
&&
&& @sorted = sort {
&& @first =
&& split ( /\D/, $a );
&& @second =
&& split ( /\D, $b );
&& $first[0]
&& <=> $second[0] || $first[1] <=>
&& $second[1];
&& }
&& @original;
&&
&& But when i was running this script,
&& the system alaways complained that
&& "it is not numeric".
@foo = split /\D/, "m:x1_1:_vert#id";
print map {"<$_>"} @foo;
print "\n";
__END__
<><><><1><1>
You are splitting on 'm', ':', 'x', '_', ':', '_', etc, and then
throwing away trailing empty fields. Splitting on /\D+/ would help,
but you would still have a leading empty field. Better is to extract
what you want:
sort {@first = $a =~ /\d+/g;
@second = $b =~ /\d+/g;
$first [0] <=> $second [0] ||
$first [1] <=> $second [1]} @original;
However, that does a lot of work many times. Better is to use a
Schwartzian transform, or a GRP transform. For instance:
sort map { $_ -> [0]}
sort { $a -> [1] <=> $b -> [1] || $a -> [2] <=> $b -> [2]}
map {[$_ => /\d+/g]} @original;
Abigail
--
perl -we 'print split /(?=(.*))/s => "Just another Perl Hacker\n";'
-----------== Posted via Newsfeeds.Com, Uncensored Usenet News ==----------
http://www.newsfeeds.com The Largest Usenet Servers in the World!
------== Over 73,000 Newsgroups - Including Dedicated Binaries Servers ==-----
------------------------------
Date: Mon, 15 Nov 1999 11:42:24 GMT
From: Tim Richardson <ter@my-deja.com>
Subject: Netscape messenger or other mail client accessable, Win 32?
Message-Id: <80orj0$res$1@nnrp1.deja.com>
I'd like to have Perl do some processing of email messages in my POP
client; this would include moving messages between folders and sending
mail (which I can do with other modules already, I know).
I like to use Netscape on Win 32.
Is there a module that allows Perl to access the Netscape mail database?
Netscape 4.x doesn't seem to allow OLE or whatever it's called these
days to manipulate messages in the Messenger mail client.
I suppose MS Outlook does, but I'm not very keen to swap to Outlook.
--
Tim Richardson
(search string: qweeblebeast)
Sent via Deja.com http://www.deja.com/
Before you buy.
------------------------------
Date: Mon, 15 Nov 1999 14:37:04 +0100
From: Chris Brunet <cbrunet@wanadoo.fr>
Subject: pb calling external command in CGI
Message-Id: <38300C7F.863C4363@wanadoo.fr>
hi, I have a problem in a cgi program on IIS server:
I need to call an external command ( I've tried frist with dir for
example);
I haved typed
@lines = `dir`;
print @lines;
It work in dos mode, in unix shell mode (with ls obviously) and on a
netscape enterprise server,
but on IIS 4 server, nothing at all, no output, nothing in STDERR nor in
STDOUT
I have tried too with an open pipe, with the same result,
Any idea ?????
------------------------------
Date: Mon, 15 Nov 1999 11:09:36 GMT
From: tony_123@my-deja.com
Subject: Removing all combinations of spaces/tabs at end of string
Message-Id: <80ople$q9s$1@nnrp1.deja.com>
Hi Folks
I have a string that may contain any combination of spaces or tabs
after the last character(non space or tab character). How can I remove
them
Ie all of the following
$MyString='Test \t '
$MyString='Test '
$MyString='Test '
$MyString='Test\t'
$MyString='Test\t\t\t\t\t\t\t \t \t\t \t'
would become
$MyString='Test'
Cheers
Tony
Sent via Deja.com http://www.deja.com/
Before you buy.
------------------------------
Date: Mon, 15 Nov 1999 13:18:07 GMT
From: lg@kt.dtu.dk (Lars Gregersen)
Subject: Re: Sample TCP/IP Client / Server routine in NT
Message-Id: <383007d5.18202788@news.dtu.dk>
On Wed, 10 Nov 1999 05:59:08 GMT, hdesa22@my-deja.com wrote:
>I am looking for sample code that demonstrates a simple Client - Server
>link usng TCP/IP sockets in NT.
All Perl examples that I have tried out worked on NT except when they
including fork. See the examples in IO::Socket and IO::Select.
Lars
------------------------------
Lars Gregersen (lg@kt.dtu.dk)
http://www.gbar.dtu.dk/~matlg
------------------------------
Date: Mon, 15 Nov 1999 03:52:28 -0800
From: Nancy <n.vincentNOn.SPAM@cross-systems.com.invalid>
Subject: Test of ODBC by a perl script
Message-Id: <0390cdf8.ec7a29a9@usw-ex0106-044.remarq.com>
Hi,
I've just installed Active Perl and I make test about the ODBC
connections.
I use the Perl script Test.pl. As asked, I have set up an ODBC DSN,
but I have these errors :
there is a failure when opening ODBC connections for "nameOfMyDSN"
and the test report is the following :
"Test 3a = new () : [-1811] [] "[Microsoft][Pilote Microsoft Access]
Fichier'(Inconnu)'introuvable".
When I launch a perl script (which contains the "use Win32::ODBC;")
from the web navigator, I have no error messages but I have no results
too (the script is executed in dos session).
I ask for your help, I really don't know if I have a problem with Perl
or with Odbc.
Thanks,
nancy
* Sent from RemarQ http://www.remarq.com The Internet's Discussion Network *
The fastest and easiest way to search and participate in Usenet - Free!
------------------------------
Date: Mon, 15 Nov 1999 12:14:46 GMT
From: Martin Foster <mfoster@spots.ab.ca>
Subject: Unexpected error in array
Message-Id: <382FFB18.C0A67178@spots.ab.ca>
This is a multi-part message in MIME format.
--------------9EA84D936BBEA0664CC76403
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
I was rather thrilled when I discovered that someone had taken the time
to write a module for Perl that would allow interaction with GPG. And
it worked flawlessly and has taught me a great deal on coding (I was a
bit uncertain about references until I looked at the code).
Now, I needed more functionality, such as key import, export, removal,
signing et cetera. As a result I was forced to add to your code and
mold it to my needs. I have since then renamed the module to fit in
with the project that I am working with. Of course anyone is more then
welcome to take any of the modified code, since it is GPLed after all.
However, I do have a question.
When, I originally tested all of the new additions and original
functions, I used a script called ./test.plx. This script works as
SUDO root, as nobody.nobody and as a script running under normal user
privileges. Unfortunately, things comes to a standstill, when I
attempt to use it with Apache as a CGI script.
Now, I get no errors stating "Insecure Dependency", or "Insecure
ENV{PATH}". But, I do know that the gpg program itself if not being
executed (as a test I added -x test to the file and that test passed).
And that somehow the cgi from header to point of execution is
displayed. This, I have seen once before on a SUID script, which as
mentioned before this is not.
I was wondering if anyone had any idea as to what could be causing
this. If it was something reguarding tained data or paths then the
problem would of occured while using a normal (non-cgi) script? I am
using the -w tag which should warn me of such things. Also strict is
used in both the module and the calling script. Any help that can
offered would be helpful.
I have included the code to the module. It is heavily modified (to suit
my coding style) from the orginal, but the base sub-routines are roughly
the same (for those familiar with it). And below is an example on how
it would be called.
Martin Foster
mfoster@spots.ab.ca
---------------------------------
# Eg. Home = /home/user/.gnupg
# Eg. Path = /usr/local/gnupg/bin/gpg
# Assign values to GPGProcessor
$Pgp->{homedir} = "$home/$Pgp{'PgpSUBFOLDER'}";
$Pgp->{path} = $Pgp{'PgpPATH'};
$Pgp->{passphrase} = $pass;
$Pgp->{sign} = 1;
print "\t<TEXTAREA NAME=\"MESSAGE\", ROWS=5, COLS=72>";
my @err;
my @cyphertext;
my $count;
my $size;
$Pgp->cipher(\$message, \@cyphertext, \@err);
$size = @cyphertext;
for ($count=0; $count < $size; $count++)
{
print "$cyphertext[$count]";
}
print "\n";
print "\t</TEXTAREA>\n";
---------------------------------
And as stated the HTML from header to <TEXTAREA ...> will be shown int
he text area.
--------------9EA84D936BBEA0664CC76403
Content-Type: text/plain; charset=us-ascii;
name="GPGProcessor.pm"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="GPGProcessor.pm"
################################################################################
# GPGPROCESSOR.PLX
################################################################################
# Created : Frank J. Tobin
# Modifications : Martin Foster
# Modified : 11/14/99
################################################################################
#
# GPGProcessor, GnuPG component of the Secured Mailer package.
# Copyright (C) 1999 Frank J. Tobin
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# Author of this script can be contacted at the following:
# Frank J. Tobin <ftobin@bigfoot.com>
#
##############################################################################
package
Webmail::GPGProcessor;
#########################
# USES
#########################
use strict; # Strict variable enforcement
use English; # Use of proper english
use Expect; # Expect module
use Carp;
use IPC::Open2; # Input, Output
use IPC::Open3; # Input, Output, Error handling
use FileHandle; # File handles
#########################
# New
sub new
{
my $proto = shift;
my $class = ref ($proto) || $proto;
my $self =
{
encrypt => 0, # Do not encrypt
sign => 0, # Do not sign.
passphrase => '', # Secret-key passphrase
employ => 1, # Employ passphrase
interactive => 0, # Have user interact directly with GPG
recipients => [], # Encryption recipients.
armor => 1, # Ascii armor
clearsign => 1, # Do not clearsign.
symmetric => 0, # Do not only symmetrically encrypt
secretKeyID => '', # GPG decides.
homedir => '', # Homedir
path => '', # Path to gnupg
pgp50compatibility => 0, # Compatibility with PGP5
stdout => 1, # Standard output
};
bless( $self, $class );
$self->_init( @_ );
return $self;
}
#########################
# Initialization
sub _init
{
my $self = shift;
if ( @_ )
{
my %extra = @_;
@{ $self }{ keys %extra } = values %extra;
}
}
#########################
# Pass Phrase Test
sub passphraseTest
{
#########################
# Data Members
my $self = shift;
my @trash;
#########################
# Program Area
if ( scalar @_ ) { $self->{passphrase} = shift @_; }
unless ( $self->{passphrase} ) { croak 'No passphrase defined to test!'; }
# Test passphrase
my $PGPIN = new FileHandle; # Input filehandle
my $PGPOUT = new FileHandle; # Output filehandle
my $PGPERR = new FileHandle; # Error handler
my @cmd = ( $self->{path}, '--sign', '--passphrase-fd', '0', '--quiet' );
# Specify key
if ( $self->{secretKeyID} )
{ push ( @cmd, '--default-key ', $self->{secretKeyID} ); }
# Home directory
if ( $self->{homedir} )
{ push ( @cmd, '--homedir', $self->{homedir} ); }
open3($PGPIN, $PGPOUT, $PGPERR, @cmd );
print $PGPIN $self->{passphrase}, $INPUT_RECORD_SEPARATOR;
$PGPIN->close();
$PGPERR->close();
# Actually test if there is any out.
if ( $PGPOUT->getline() )
{
$PGPOUT->close(); # Close filehandle
return 1; # Return true
}
# Equivilant to else
$PGPOUT->close(); # Close filehandle
return 0; # Return false
}
#########################
# Encryption
sub cipher
{
#########################
# Data Members
my $self = shift;
#########################
# Program area
my @cmd = ( $self->{path} ); # Create initial line
# Verify if all parameters are met
unless ( $self->{encrypt} or $self->{sign} )
{ croak 'Did not specify to encrypt or sign message.'; }
# If encryption selected
if ( $self->{encrypt} )
{
push @cmd, '--encrypt';
}
# If signature selected
if ( $self->{sign} )
{
push @cmd, ( $self->{clearsign} ? '--clearsign' : '--sign' );
}
# Check for recipients
if ( $self->{encrypt} )
{
# List of recipients
if ( scalar @{ $self->{recipients} } )
{
# need to add --recipient to each recipient
push
@cmd, map { ( '--recipient' => $_ ) } @{ $self->{recipients} };
}
# Display error message
else
{ croak 'Must specify recipients for encryption'; }
}
# Extraneous command-line parameters
if ( $self->{armor} )
{ push ( @cmd, '--armor' ); }
# Symetric Encryption and Recipients
if ( $self->{symmetric} and scalar @{ $self->{recipients} } )
{ croak 'Cannot symmetrically encrypt and have recipients'; }
# Symetric encryption
if ( $self->{symmetric} ) { push ( @cmd, '--symmetric' ); }
# PGP5 Compatibility
if ( $self->{pgp50compatibility} )
{ push ( @cmd, '--compress-algo', '1', '--force-v3-sigs' ); }
# Home directory
if ( $self->{homedir} )
{ push ( @cmd, '--homedir', $self->{homedir} ); }
return $self->pipePGP( [ @cmd ], @_ );
}
#########################
# Decryption
sub verify
{
#########################
# Data Members
my $self = shift;
#########################
# Program Area
my @cmd = ( $self->{path}, '--decrypt' ); # Create initial line
# Home directory
if ( $self->{homedir} )
{ push ( @cmd, '--homedir', $self->{homedir} ); }
return $self->pipePGP( [ @cmd ], @_ );
}
#########################
# Key Retreival
sub getKeys
{
#########################
# Data Members
my $self = shift;
#########################
# Program Area
$self->{employ} = 0; # Passphrase not needed for op
my @cmd = ( $self->{path}, '--list-public-keys' ); # Create initial line
# Home directory
if ( $self->{homedir} )
{ push ( @cmd, '--homedir', $self->{homedir} ); }
return $self->pipePGP( [ @cmd ], @_ );
}
#########################
# Key Export
sub exportKey
{
#########################
# Data Members
my $self = shift; # Ones self
my $key = shift; # Key to export
#########################
# Program Area
$self->{employ} = 0; # Passphrase not needed for op
my @cmd = ( $self->{path} ); # Create initial line
# Extraneous command-line parameters
if ( $self->{armor} )
{ push ( @cmd, '--armor' ); }
# Home directory
if ( $self->{homedir} )
{ push ( @cmd, '--homedir', $self->{homedir} ); }
push ( @cmd, '--export', $key );
return $self->pipePGP( [ @cmd ], @_ );
}
#########################
# Key Import
sub importKey
{
#########################
# Data Members
my $self = shift; # Ones self
my $key = shift; # Key
my $output = shift; # Output
my $PGPIN = new FileHandle; # Input
my $PGPOUT = new FileHandle; # Output
#########################
# Program Area
$self->{employ} = 0; # Passphrase not needed for op
my @cmd = ( $self->{path}, '--import' ); # Create initial line
# Home directory
if ( $self->{homedir} )
{ push ( @cmd, '--homedir', $self->{homedir} ); }
open2($PGPOUT, $PGPIN, @cmd); # Open filehandle
print $PGPIN "${$key}"; # Print key
close ($PGPIN); # Close input filehandle
@{ $output } = $PGPOUT->getlines(); # Retreive output
close ($PGPOUT); # Close output
}
#########################
# Key Removal
sub delKey
{
#########################
# Data Members
my $self = shift; # Ones self
my $key = shift; # Key
my $command;
#########################
# Program Area
my @cmd = ( $self->{path} ); # Create initial line
# Home directory
if ( $self->{homedir} )
{ push ( @cmd, '--homedir', $self->{homedir} ); }
push ( @cmd, '--delete-key', "\'$key\'" ); # Complete command line
$command = Expect->spawn("@cmd") # Spawn process
or die "Could not start program: $!\n";
$command->log_stdout($self->{stdout}); # Log Standard output
$command->expect(10, 'keyring?'); # Wait for prompt
print $command "y\r"; # Enter 'Y'
$command->soft_close(); # Close process
}
#########################
# Key Signing
sub signKey
{
#########################
# Data Members
my $self = shift; # Ones self
my $key = shift; # Key
my $command;
#########################
# Program Area
my @cmd = ( $self->{path} ); # Create initial line
# Home directory
if ( $self->{homedir} )
{ push ( @cmd, '--homedir', $self->{homedir} ); }
push ( @cmd, '--edit-key', "\'$key\'" ); # Complete command line
$command = Expect->spawn("@cmd") # Spawn process
or die "Could not start program: $!\n";
$command->log_stdout($self->{stdout}); # Log Standard output
$command->expect(10, 'Command>'); # Wait for prompt
print $command "lsign\r"; # Enter sign command
$command->expect(10, 'sign?'); # Wait for prompt
print $command "y\r"; # Agree
$command->expect(10, 'passphrase:'); sleep(5); # Wait for prompt and sleep
print $command "$self->{passphrase}\r"; # Enter passphrase
$command->expect(10, 'Command>'); # Wait for prompt
print $command "save\r"; # Enter save command
$command->soft_close(); # Close process
}
#########################
# Key Trust Level
sub trustKey
{
#########################
# Data Members
my $self = shift; # Ones self
my $key = shift; # Key
my $trust = shift; # Trust level
my $command;
#########################
# Program Area
my @cmd = ( $self->{path} ); # Create initial line
# Home directory
if ( $self->{homedir} )
{ push ( @cmd, '--homedir', $self->{homedir} ); }
push ( @cmd, '--edit-key', "\'$key\'" ); # Complete command line
$command = Expect->spawn("@cmd") # Spawn process
or die "Could not start program: $!\n";
$command->log_stdout($self->{stdout}); # Log Standard output
$command->expect(10, 'Command>'); # Wait for prompt
print $command "trust\r"; # Enter commant
$command->expect(10, 'decision?'); # Wait for prompt
print $command "$trust\r"; # Specify trust level
$command->expect(10, 'Command>'); # Wait for prompt
print $command "quit\r"; # Enter quit
$command->soft_close(); # Close process
}
#########################
# PGP Pipes
sub pipePGP
{
#########################
# Data Members
my $self = shift;
my $cmd = shift;
my $USERIN = shift;
my $USEROUT = scalar @_ ? shift : undef;
my $USERERR = scalar @_ ? shift : undef;
# $PGPIN meant to be the FD providing both password and $USERIN
my $PGPIN = new FileHandle; # Input
my $PGPOUT = new FileHandle; # Output
my $PGPERR = new FileHandle; # Error
###########################
# Program area
# Additional stuff pertinent to both verifing and encrypting
if ( not $self->{interactive} )
{ push @{ $cmd }, '--batch', '--passphrase-fd', 0; }
# Use another key
if ( $self->{secretKeyID} )
{ push @{ $cmd }, '--default-key', $self->{secretKeyID}; }
# STDIN, STDOUT, STDERR user-selected
if ( defined $USERERR ) { open3( $PGPIN, $PGPOUT, $PGPERR, @{ $cmd } ); }
# STDIN, STDOUT, user-selected
elsif (defined $USEROUT ) { open2( $PGPOUT, $PGPIN, @ { $cmd } ); }
# One FH user-selected
else { open2 ( $PGPOUT, $PGPIN, @{ $cmd } ); }
if ($self->{employ})
{
# Non-interactive needs to print passphrase
if ( not $self->{interactive} )
{ $PGPIN->print( $self->{passphrase}, $INPUT_RECORD_SEPARATOR ); }
}
else { $self->{employ} = 1; } # Reset
$PGPIN->print( ${ $USERIN } );
$PGPIN->close(); # Close the input pipe
# Grab the out.
if ( defined $USERERR )
{
@{ $USEROUT } = $PGPOUT->getlines();
@{ $USERERR } = $PGPERR->getlines();
return scalar @{ $USEROUT };
}
elsif ( defined $USEROUT )
{
@{ $USEROUT } = $PGPOUT->getlines();
return scalar @{ $USEROUT };
my $pid;
unless (defined($pid = open(KID, "-|")))
{
die "ACK";
}
if ($pid)
{
while(<KID>) { };
close KID;
}
else
{
$ENV{PATH} = "/usr/local/gnupg/bin";
print "$ENV{PATH}";
my $pid;
unless (defined($pid = open(KID, "-|")))
{
die "ACK";
}
if ($pid)
{
while(<KID>) { };
close KID;
}
else
{
$ENV{PATH} = "/usr/local/gnupg/bin";
print "$ENV{PATH}";
my $pid;
unless (defined($pid = open(KID, "-|")))
{
die "ACK";
}
if ($pid)
{
while(<KID>) { };
close KID;
}
else
{
$ENV{PATH} = "/usr/local/gnupg/bin";
print "$ENV{PATH}";
my $pid;
unless (defined($pid = open(KID, "-|")))
{
die "ACK";
}
if ($pid)
{
while(<KID>) { };
close KID;
}
else
{
$ENV{PATH} = "/usr/local/gnupg/bin";
print "$ENV{PATH}";
my $pid;
unless (defined($pid = open(KID, "-|")))
{
die "ACK";
}
if ($pid)
{
while(<KID>) { };
close KID;
}
else
{
$ENV{PATH} = "/usr/local/gnupg/bin";
print "$ENV{PATH}";
my $pid;
unless (defined($pid = open(KID, "-|")))
{
die "ACK";
}
if ($pid)
{
while(<KID>) { };
close KID;
}
else
{
$ENV{PATH} = "/usr/local/gnupg/bin";
print "$ENV{PATH}";
my $pid;
unless (defined($pid = open(KID, "-|")))
{
die "ACK";
}
if ($pid)
{
while(<KID>) { };
close KID;
}
else
{
$ENV{PATH} = "/usr/local/gnupg/bin";
print "$ENV{PATH}";
}
}
1;
--------------9EA84D936BBEA0664CC76403--
------------------------------
Date: Mon, 15 Nov 1999 13:40:20 +0100
From: "Andrew Longworth" <Andrew_Longworth@bigfoot.com>
Subject: Using files
Message-Id: <382fff37@isoit370.bbn.hp.com>
Hi, I have a problem with a file. There is a text file that contains
information that I need to use in a script. There are sometime spaces and
newlines and tabs around the text.
How can I ignore these and simply retrieve the data?
------------------------------
Date: 16 Sep 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 16 Sep 99)
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.
| NOTE: The mail to news gateway, and thus the ability to submit articles
| through this service to the newsgroup, has been removed. I do not have
| time to individually vet each article to make sure that someone isn't
| abusing the service, and I no longer have any desire to waste my time
| dealing with the campus admins when some fool complains to them about an
| article that has come through the gateway instead of complaining
| to the source.
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.
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 V9 Issue 1380
**************************************
