This script works on localhost with the -w switch but not without. It also works when use strict and use warning are active.
apache2/error.log:
without switch (aborted script):
(2)No such file or directory: exec of ... failed
with the switch I get:
Use of uninitialized value $email_flag in string ne ...
which looks initialised to me.
On the live web server neither one works. Perl is new to me, but I know some BASH and PHP.
I run Debian Lenny, Apache2, Perl 5.10.
#!/usr/bin/perl -w
$| = 1;
my $mailprog = '/usr/sbin/sendmail'; # where the mail program lives
my $to = "not\#for.you"; # where the mail is sent
my ($command,$email,#pairs,$buffer,$pair,$email_flag) ;
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
#pairs = split(/&/, $buffer);
foreach $pair (#pairs) {
# Split the pair up into individual variables. #
my($name, $value) = split(/=/, $pair);
# Decode the form encoding on the name and value variables. #
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# If they try to include server side includes, erase them, so they
# aren't a security risk if the html gets returned. Another
# security hole plugged up.
$value =~ s/<!--(.|\n)*-->//g;
## print "Name of form element is $name with value of $value \n";
if ($name eq 'email') {
$email = $value;
}
if ($name eq 'command') {
$command = $value;
}
}
if ($email =~ /(#.*#)|(\.\.)|(#\.)|(\.#)|(^\.)/ ||
$email !~ /^.+\#(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/ ) {
$email_flag = "ERROR";
}
my $urlcommand = $command;
if ($command eq 'Subscribe') {
$command = "SUBSCRIBE rpc-news";
}
if ($command eq 'Unsubscribe') {
$command = "UNSUBSCRIBE rpc-news";
}
if ($command eq 'Suspend') {
$command = "SET rpc-news NOMAIL";
}
if ($command eq 'Resume') {
$command = "SET rpc-news MAIL";
}
my $getInfo = '';
print "Content-Type: text/html\n";
if ($email_flag ne "ERROR") {
open(MAIL,"|$mailprog -t");
print MAIL "To: $to\n";
print MAIL "From: $email\n";
print MAIL "Subject: [rpc-news] $command \n";
print MAIL "Reply-to: $email \n";
print MAIL "$command \n";
print MAIL "EXIT \n";
close (MAIL);
$getInfo = "?result=good";
}
if ($email_flag eq "ERROR") {
$getInfo = "?result=bad";
}
my $rootURL= $ENV{'SERVER_NAME'};
my $url = "http://${rootURL}/thank_you.html${getInfo}&action=${urlcommand}";
print "Location: $url\n\n";
Did you create your script on a Windows machine and upload it to a Linux server without fixing the line endings? Without the -w switch, the shebang line may look like "#!/usr/bin/perl\r", so the system goes looking for a program named "perl\r" (or however the line ending looks). With the -w switch, "#!/usr/bin/perl" doesn't have an indecipherable line ending stuck to it. Instead, that gets stuck to -w where it doesn't cause failure.
I thought there was a perlfaq about this, but I can't seem to find it in the docs at the moment.
Update: I found it over on PerlMonks, in a really old Q&A topic that seems unrelated until you read the body of the message: Answer: How to get rid of premature end of script headers. Yeah, I know, if you were just browsing threads you wouldn't even stop on that one. But here's the text of the post:
If you developed this script on
Windows, it's possible that the script
file has non-UNIX line endings. (The
perl interpreter can handle them, but
the shebang line is interpreted by the
shell, and is not tolerant of
incorrect line endings.) If this is
the problem, the script may terminate
with an error right at the shebang
line.
Use of uninitialized value $email_flag in string ne ...
which looks initialised to me.
if ($email =~ /(#.*#)|(\.\.)|(#\.)|(\.#)|(^\.)/ ||
$email !~ /^.+\#(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/
) {
$email_flag = "ERROR";
}
$email_flag only gets initialized here if the pattern matches - otherwise it's left undefined. You could add an else clause to ensure it gets initialized no matter what.
I would not use that code, it doesn't use CGI.pm (or CGI::Simple ...)
Get "TFMail -- Improved Form Mail" from "nms - web programs written by experts"
Its simple to install, and its written well ( it uses CGI ...)
Related
I am currently using Cpanel to setup an email forward that goes through a feature in CPanel email forwarding "Pipe to Program". In this perl script, I grab the headers and replace them with the Epson email print address, as Epson printers do not like direct forwarding. However, I am having the issue where sending to multiple users at once causes errors and it does not like more than 1 recipient.
My code is below:
#!/usr/bin/perl
use strict;
# Real email address for the printer
my $email = 'example#domain.com';
my $sm;
open($sm, "|/usr/sbin/sendmail -t");
my $in_header = 1;
while (my $line = <STDIN>) {
chomp $line;
# Empty line while in headers means end of headers
if ($in_header && $line eq '') {
$in_header = 0;
}
# Replace To: field if we're in headers
if ($in_header && $line =~ m/^To: /) {
$line = "To: $email";
}
# Pass through to sendmail
print $sm "$line\n";
}
close($sm);
I have a feeling the root of my issues comes from this line in my code:
# Replace To: field if we're in headers
if ($in_header && $line =~ m/^To: /) {
$line = "To: $email";
}
I have to admit something, I found this code snippet online and I am completely unfamiliar with Perl in order to find a viable solution to be able to forward to multiple emails without issue. Any indication on where I could start, even if a full solution isn't clear, would be very helpful.
Resources:
https://www.cravingtech.com/how-to-setup-epson-email-print-using-your-own-domain-name.html
#!/usr/bin/perl
use strict;
my $email = 'example#domain.com';
my $sm;
open($sm, "|/usr/sbin/sendmail -t");
my $in_header = 1;
my $in_to = 0;
while (my $line = <STDIN>) {
chomp $line;
# Empty line while in headers means end of headers
if ($in_header && $line eq '') {
$in_header = 0;
}
# Email Header
if ($in_header){
if($line =~ m/^To: /) {
$in_to = 1;
$line = "To: $email";
} elsif($in_to) {
if($line =~ /:/){
$in_to = 0;
}else{
next;
}
}
}
print $sm "$line\n";
}
close($sm);
This ended up being my solution after many hours of trial and error.
Just posting this here in case anyone runs into my very niche issue lol.
Thanks.
I have a certain script , which will segregate the log file and put the result.txt which is comming as expected. But i want to sent mail after this segregate log file attach it in the text file and sent. There is no error in this script but i need to enhance it. Please help me on how i can use it
#use Win32;
if (#ARGV != 2) {
print "Please pass atleast one paramer\n";
print "Usage:\n\t $0 <file_name><Pattern>\n";
exit;
}
$File_name = $ARGV[0];
$res_File_name = $File_name . "\.result\.txt";
$Pattern = $ARGV[1];
chomp($Pattern);
open(FD,"$File_name") or die ("File '$File_name' could not be open \n");
open(WFD,">$res_File_name") or die("File $res_File_name could not be opened\n");
print "Enter begin match pattern: ";
$bgn = <stdin>;
chomp($bgn);
print $bgn;
print "Enter end match pattern: ";
$en = <stdin>;
chomp($en);
while ($line = <FD>) {
chomp($line);
if ($line =~ /^$bgn/) { #seaching a patter at begining of the string.
print WFD "Begin pattern '$bgn' matched with the line '$line'\n";
}
if ($line =~ /$en$/) { #seaching a patter at end of the string.
print WFD "End pattern '$en' matched with the line '$line'\n";
#exit;
}
print WFD $_ if(/$Pattern/);
# main();
# use constant Service_Name =>'MyServ'
# use constant Service_Desc =>'MyServDesc'
# sub main()
# {
# $opt=shift(# ARGV)||""
# if ($opt =~ /^(-i|--install)$/i)
# {
install _service( Service_Name, Service_Desc)
# }
# elsif ($opt =~ /^(-r|--remove)$/i)
# {
# remove_service(Service_Name);
# }
# elsif ($opt =~ /^(run)$/i)
#}
# here we create a log file wth STDOUT and STDERR
# The log file will be created with extension .log
$log = $cwd . $bn . ".log";
# open(STDOUT, ">> $log") or die "Couldn't open $log for appending: $!\n";
# open(STDERR, ">&STDOUT") or die "Could";
close(FD);
close(WFD);
The standard way to create and send email using Perl is to use the many modules in the Email::* namespace.
For creating simple email, you should use Email::Simple.
use Email::Simple;
my $email = Email::Simple->create(
header => [
From => 'casey#geeknest.com',
To => 'drain#example.com',
Subject => 'Message in a bottle',
],
body => '...',
);
$email->header_set( 'X-Content-Container' => 'bottle/glass' );
For more complex email (i.e. ones with multiple parts, like file attachments or HTML versions) use Email::MIME.
To send an email, use Email::Sender (actually, in most cases, you can probably get away with Email::Sender::Simple)
use Email::Sender::Simple qw(sendmail);
sendmail($email); # The $email we created in the previous example.
Your first "enhancement" should be to add use strict and use warnings to the top of your program, and declare all your variables using my. That should be your first thought when writing any Perl program.
As for sending an email, you don't say what it is you want to send, but I suggest you use the MIME::Lite module.
I did a simple script using perl and I was wondering how I can pause the program or return it to the action before? I have this code
print "put your name:";
$s=<>;
and it didn't output anything. I want the program to repeat the same action, i.e. asking the user to enter his name instead of progressing.
my $s = '';
while ($s eq '') {
print "put your name:";
chomp($s = <>);
}
print "The name you entered is $s \n";
No need to set $name to anything before you start - just define it:
my $name;
while ( not length $name ) { #Thx Dave Cross
print "What is your name? ";
$name = <STDIN>;
chomp $name;
}
In Perl, variables defined with my (and that should be 99% of your variables) have a limited scope. If they're defined in a block (something that uses curly braces like this while loop), they'll lose their value once they leave the block. That's why I have to have my $name; before the while.
The while ( not $name ) { will work if $name isn't defined or is a null value, so this will loop until I enter something into $name that's not null.
The chomp removes the NL character that I enter when I press the <ENTER> key. You should always chomp your variables after a read of any sort. Just get use to it.
In this form, the loop is self documenting. I am looping while $name isn't filled in.
You can combine the chomp with the input like this:
my $name;
while ( not $name ) {
print "What is your name? ";
chomp ( $name = <STDIN> );
}
Some people like this because it's a bit shorter, but I don't know if its any clearer. I'm a fan of code clarity because it's easier to maintain.
sub readstr {
while (my $in = <>) {
chomp $in;
return $in if length $in;
}
"";
}
print "put your name:";
my $s = readstr();
Hello guys i need to capture the output of an external command, herefore I use backquotes.
However when the command reaches a newline the output is ommitted. Where $_ = AD
#lines = `"C:/Program Files/Veritas/NetBackup/bin/admincmd/bppllist" $_ -U"`
Test: test1
Test: test2
Test: test3
Test: test4
The actual output:
#lines
Test: test1
Test: test2
Thank you for your time.
print HTML "<h2 id='pol'>Policy Configuration\n</h2>" ;
#bpllist =`"$admincmd/bppllist.exe"` or die print "$admincmd/bppllist.exe not found or could not be executed";
foreach (#bpllist)
{
print HTML "<div><table class='table'>\n";
#lines = `"$admincmd/bppllist" $_ -U` or die print "$admincmd/bpplinfo $_ -U not found or could not be executed";
print HTML "\t<tr>\n\t<td><b>Policy name: <b></td><td>$_</td>\n\t</tr>\n" ;
foreach (#lines) {
chop;
($var, $value) = split(/:/,$_,2);
$var = "" if !defined($var);
$value = "" if !defined($value);
print HTML "\t<tr>\n\t<td>$var</td><td>$value</td>\n\t</tr>\n" ;
}
print HTML "</table></div>";
}
The output of #bpllist:
AD
Sharepoint
Echchange
Vmware
Here's how to capture the STDOUT & STDERR of a spawned process using backticks:
my $output = join('', `command arg1 arg2 arg3 2>&1`);
How it works has no dependence whatsoever on newlines in the output of command.
If you also need to send text to command's STDIN, then use IPC::Open3.
Cleaned your code up a bit. It works for me.
use strict;
use warnings;
use 5.10.0;
# something missing here to set up HTML file handle
# something missing here to set up $admincmd
print HTML q{<h2 id='pol'>Policy Configuration\n</h2>};
my #bpllist = `"$admincmd/bppllist.exe"`
or die "$admincmd/bppllist.exe not found or could not be executed\n";
for my $policy (#bpllist) {
print HTML q{<div><table class='table'>\n};
my #lines = `$admincmd/bpplinfo.exe $policy -U 2>&1`;
print HTML qq{\t<tr>\n\t<td><b>Policy name: <b></td><td>$policy</td>\n\t</tr>\n} ;
for my $pair (#lines) {
chomp($pair); # only remove newlines, not other characters
my ($var, $value) = split /:/, $pair, 2;
$var //= '';
$value //= '';
print HTML qq{\t<tr>\n\t<td>$var</td><td>$value</td>\n\t</tr>\n} ;
}
print HTML q{</table></div>};
}
Update 2
You appear to be doing this on windows?
I don't think the 2>&1 trick will work there.
Instead of using qx or backticks and then shell commands to redirect output, give the core module, IPC::Cmd, a try. In particular, its exportable function &run will conveniently capture both STDOUT and STDERR for you. From the synopsis:
### in list context ###
my( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf ) =
run( command => $cmd, verbose => 0 );
Maybe the command send its output to stderr.
Try this:
my $output = `'command' -ARG -L 2>&1`;
regards,
I am creating a perl script that takes in the a file (example ./prog file)
I need to parse through the file and search for a string. This is what I thought would work, but it does not seem to work. The file is one work per line containing 50 lines
#array = < >;
print "Enter the word you what to match\n";
chomp($match = <STDIN>);
foreach $line (#array){
if($match eq $line){
print "The word is a match";
exit
}
}
You're chomping your user input, but not the lines from the file.
They can't match; one ends with \n the other does not. Getting rid of your chomp should solve the problem. (Or, adding a chomp($line) to your loop).
$match = <STDIN>;
or
foreach $line (#array){
chomp($line);
if($match eq $line){
print "The word is a match";
exit;
}
}
Edit in the hope that the OP notices his mistake from the comments below:
Changing eq to == doesn't "fix" anything; it breaks it. You need to use eq for string comparison. You need to do one of the above to fix your code.
$a = "foo\n";
$b = "bar";
print "yup\n" if ($a == $b);
Output:
yup