summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorFlorian Pritz <bluewind@xssn.at>2010-08-08 22:51:46 +0200
committerFlorian Pritz <bluewind@xssn.at>2010-08-08 22:51:46 +0200
commit176f5e0c0e6730908f35aebf60a1e33f8735a025 (patch)
tree879c10b997aa124ea8771bdfb4e09c93f52a6871
parentd2754512c34a19dad7e489b97fd80bf0bd634089 (diff)
downloadbin-176f5e0c0e6730908f35aebf60a1e33f8735a025.tar.gz
bin-176f5e0c0e6730908f35aebf60a1e33f8735a025.tar.xz
add 3 more files
Signed-off-by: Florian Pritz <bluewind@xssn.at>
-rwxr-xr-xrestore.pl78
-rwxr-xr-xshop157
-rwxr-xr-xsmtp-cli814
3 files changed, 1049 insertions, 0 deletions
diff --git a/restore.pl b/restore.pl
new file mode 100755
index 0000000..5e7214c
--- /dev/null
+++ b/restore.pl
@@ -0,0 +1,78 @@
+#!/usr/bin/perl
+#----------------------------------------------------
+# Version: 0.1.0
+# Author: Florian "Bluewind" Pritz <flo@xssn.at>
+#
+# Licensed under WTFPL v2
+#
+#----------------------------------------------------
+# Simplify rsnapshot restores
+#----------------------------------------------------
+use warnings;
+use strict;
+use File::Basename;
+use Cwd;
+use DateTime;
+use File::Copy::Recursive qw(rcopy);
+use File::Find;
+use File::Path qw(remove_tree);
+
+my $backuppath = "/mnt/backup";
+my %mapping = (
+ "^/srv" => "/home/srv"
+ );
+
+if (@ARGV == 0) {
+ print "usage: ", basename($0), " files(s)...\n";
+ exit 0;
+}
+
+for my $filename (@ARGV) {
+ my @filelist;
+ my $file = Cwd::abs_path($filename);
+ my $lastmodtime = 0;
+
+ for my $key (keys %mapping) {
+ $file =~ s/$key/$mapping{$key}/;
+ }
+
+ for (glob("$backuppath/*")) {
+ my $backupfile = "$_$file";
+ my $modtime = 0;
+
+ # skip everything that doesn't seem to be a backup
+ next unless -d and -r and -x;
+ next unless -e $backupfile;
+
+ if (-d $backupfile) {
+ find(sub {
+ my $current_mtime = (stat($File::Find::name))[9] or return;
+ $modtime = $current_mtime if ($current_mtime > $modtime);
+ }, $backupfile);
+ } else {
+ $modtime = (stat($backupfile))[9];
+ }
+ push @filelist, {path => $backupfile, time => $modtime};
+ }
+
+ @filelist = sort { $a->{time} cmp $b->{time} } @filelist;
+ my $i = 0;
+ for my $backupfile (@filelist) {
+ if ($backupfile->{time} != $lastmodtime) {
+ my $dt = DateTime->from_epoch(epoch => $backupfile->{time});
+ print "\e[0;33m$i: \e[1;33m", $dt->strftime("%F %H:%M:%S"),"\e[0m ", $backupfile->{path}, "\n";
+ $lastmodtime = $backupfile->{time};
+ }
+ $i++;
+ }
+
+ print "\e[0;34mEnter ID to restore (Enter to skip): \e[0m";
+ my $id = <STDIN>;
+ chomp $id;
+ next unless ($id =~ /^\d+$/);
+ remove_tree $file if -d $file;
+ # need mtime preservation
+ #rcopy $filelist[$id]->{path}, $file;
+ system "cp -a \"$filelist[$id]->{path}\" \"$file\"";
+ print "\e[0;32mrestored $file\e[0m\n";
+}
diff --git a/shop b/shop
new file mode 100755
index 0000000..c2e01fe
--- /dev/null
+++ b/shop
@@ -0,0 +1,157 @@
+#!/bin/bash
+#
+# shop - Show Permissions at all levels of a given path
+#
+# With `tree(1)` you start at a trunk and show all leaves that
+# originate from that trunk, optionally showing permissions.
+# `shop` starts at a leaf and shows the permissions back to a
+# trunk.
+#
+# CREATED: 2009-09-03 17:30
+# MODIFIED: 2009-11-17 11:05
+
+_NAME=$(basename $0)
+_VERSION=1.0
+
+# DEFAULTS
+unset octal # use text mode instead of octal mode
+level=-1 # traverse all the way up to /
+trunk='/' # traverse all the way up to /
+pad=17 # padding for pathname
+
+usage() {
+ cat <<EOT
+Usage: $_NAME [-L N] [-o] [-t PATH] [PATH1..]
+
+Options:
+ -L, --level N traverse N levels up the tree
+ -o, --octal show octal mode instead of human readable mode
+ -t, --trunk PATH only traverse up to PATH instead of / (root)
+ - takes precedence over --level
+ -p, --pad N allow USER:GROUP N characters before directory name
+ default: 17
+
+ -h, --help show this message
+ --version show version info
+EOT
+}
+
+_shop() {
+ [ $octal ] && stat_str="%a" || stat_str="%A"
+
+ stats=( $(stat -c "$stat_str %U:%G %n" "$1") )
+
+ if [ $octal ]; then
+ # `stat -c "%a"` only returns a 4 digit mode when the first digit is
+ # nonzero, yet `stat` always returns a 4 digit mode. how annoying...
+ [ ${#stats} -eq 3 ] && echo -n "0"
+ fi
+
+ printf "%s %-${pad}s ${stats[@]:2}\n" "${stats[@]:0:2}"
+}
+
+main() {
+ arg="$1"
+ if [ -z "$arg" ]; then
+ # user didn't supply an arg, use current working dir
+ arg="$PWD"
+ fi
+
+ until [ -z "$arg" ]; do
+ if ! [ -a "$arg" ]; then
+ echo "error: $arg does not exist"
+ return 1
+ fi
+
+ # if $arg is a directory, prime the directory stack, else use
+ # the parent dir of $arg to prime the stack
+ if [ -d "$arg" ]; then
+ cd "$arg" || return 1
+ unset file_arg
+ else
+ cd $(dirname -- "$arg") || return 1
+ file_arg=1
+ let "level -=1"
+ fi
+
+ start_dir=$PWD
+
+ # populate directory stack with $level levels on the path to
+ # the $trunk
+ while [ "$PWD" != "$trunk" ]; do
+ if [ $level -gt 0 ] || [ $level -lt 0 ]; then
+ let "level -= 1"
+ pushd .. &> /dev/null
+ elif [ $level -eq 0 ]; then
+ break;
+ fi
+ done
+
+ # display the permissions for each level
+ while [ "$PWD" != "$start_dir" ]; do
+ _shop "$PWD"
+ popd &> /dev/null
+ done
+ _shop "$PWD"
+
+ # leaf was a file, run _shop on this file as well
+ if [ $file_arg ]; then
+ _shop "${PWD}/$(basename -- "$arg")"
+ else
+ cd .. || return 1
+ fi
+
+ # user passed multiple leafs, separate output for each leaf
+ if [ $# -gt 1 ]; then
+ echo
+ fi
+
+ shift
+ arg="$1"
+ done
+}
+
+declare -a args
+until [ -z "$1" ]; do
+ case "$1" in
+ -L|--level) level="$2"
+ shift 2
+ ;;
+
+ -o|--octal) octal=1
+ shift
+ ;;
+
+ -t|--trunk) trunk="$(readlink -f $2)"
+ shift 2
+ ;;
+
+ -p|--pad) pad="$2"
+ shift 2
+ ;;
+
+ -h|--help) usage
+ exit
+ ;;
+
+ --version) echo "$_NAME v$_VERSION"
+ exit
+ ;;
+
+ --) shift
+ args=( "${args[@]}" "$@" )
+ break
+ ;;
+
+ -*) echo -e "$_NAME: unknown option: $1\n"
+ usage
+ exit
+ ;;
+
+ *) args[${#args[*]}]="$1"
+ shift
+ ;;
+ esac
+done
+
+main "${args[@]}"
diff --git a/smtp-cli b/smtp-cli
new file mode 100755
index 0000000..b732219
--- /dev/null
+++ b/smtp-cli
@@ -0,0 +1,814 @@
+#!/usr/bin/perl
+
+#
+# Command line SMTP client with STARTTLS, SMTP-AUTH and IPv6 support.
+# Michal Ludvig <michal@logix.cz>, 2003-2009
+# See http://www.logix.cz/michal/devel/smtp-cli for details.
+# Thanks to all contributors for ideas and fixes!
+#
+
+my $version = "2.6";
+
+#
+# ChangeLog:
+# * Version 2.6 (2009-08-05)
+# - Message building fixed for plaintext+attachment case.
+# - Auto-enable AUTH as soon as --user parameter is used.
+# (previously --enable-auth or --auth-plain had to be used
+# together with --user, that was confusing).
+# - New --print-only parameter for displaying the composed
+# MIME message without sending.
+# - All(?) non-standard modules are now optional.
+# - Displays local and remote address on successfull connect.
+#
+# * Version 2.5 (2009-07-21)
+# - IPv6 support provided the required modules are
+# available.
+#
+# * Version 2.1 (2008-12-08)
+# - Make the MIME modules optional. Simply disable
+# the required functionality if they're not available.
+#
+# * Version 2.0 (2008-11-18)
+# - Support for message building through MIME::Lite,
+# including attachments, multipart, etc.
+#
+# * Version 1.1 (2006-08-26)
+# - STARTTLS and AUTH support
+#
+# * Version 1.0
+# - First public version
+#
+# This program is licensed under GNU Public License v3 (GPLv3)
+#
+
+## Require Perl 5.8 or higher -> we need open(.., .., \$variable) construct
+require 5.008;
+
+use strict;
+use IO::Socket::INET;
+use MIME::Base64 qw(encode_base64 decode_base64);
+use Getopt::Long;
+use Socket qw(:DEFAULT :crlf);
+
+my ($user, $pass, $host, $port, $addr_family,
+ $use_login, $use_plain, $use_cram_md5,
+ $ehlo_ok, $auth_ok, $starttls_ok, $verbose,
+ $hello_host, $from, @to, $datasrc,
+ $missing_modules_ok, $missing_modules_count,
+ $subject, $body_plain, $body_html, $print_only,
+ @attachments, @attachments_inline,
+ $sock, $built_message);
+
+$host = 'localhost';
+$port = 'smtp(25)';
+$addr_family = AF_UNSPEC;
+$hello_host = 'localhost';
+$verbose = 0;
+$use_login = 0;
+$use_plain = 0;
+$use_cram_md5 = 0;
+$starttls_ok = 1;
+$auth_ok = 0;
+$ehlo_ok = 1;
+$missing_modules_ok = 0;
+$missing_modules_count = 0;
+$print_only = 0;
+
+# Get command line options.
+GetOptions (
+ 'host|server=s' => \$host,
+ 'port=i' => \$port,
+ '4|ipv4' => sub { $addr_family = AF_INET; },
+ '6|ipv6' => sub { $addr_family = AF_INET6; },
+ 'user=s' => \$user, 'password=s' => \$pass,
+ 'auth-login' => \$use_login,
+ 'auth-plain' => \$use_plain,
+ 'auth-cram-md5' => \$use_cram_md5,
+ 'disable-ehlo' => sub { $ehlo_ok = 0; },
+ 'force-ehlo' => sub { $ehlo_ok = 2; },
+ 'hello-host|ehlo-host|helo-host=s' => \$hello_host,
+ 'auth|enable-auth' => \$auth_ok,
+ 'disable-starttls|disable-tls|disable-ssl' =>
+ sub { $starttls_ok = 0; },
+ 'from|mail-from=s' => \$from,
+ 'to|rcpt-to=s' => \@to,
+ 'data=s' => \$datasrc,
+ 'subject=s' => \$subject,
+ 'body|body-plain=s' => \$body_plain,
+ 'body-html=s' => \$body_html,
+ 'attachment|attach=s' => \@attachments,
+ 'attachment-inline|attach-inline=s' => \@attachments_inline,
+ 'print-only' => \$print_only,
+ 'missing-modules-ok' => \$missing_modules_ok,
+ 'v|verbose+' => \$verbose,
+ 'version' => sub { &version() },
+ 'help' => sub { &usage() } );
+
+#### Try to load optional modules
+
+## IO::Socket::SSL and Net::SSLeay are optional
+my $have_ssl = eval { require IO::Socket::SSL; require Net::SSLeay; 1; };
+if (not $have_ssl and not $missing_modules_ok) {
+ warn("!!! IO::Socket::SSL and/or Net::SSLeay modules are not found\n");
+ warn("!!! These modules are required for STARTTLS support\n");
+ $missing_modules_count += 2;
+}
+
+## IO::Socket::INET6 and Socket6 are optional
+my $socket6 = eval { require IO::Socket::INET6; require Socket6; 1; };
+if (not $socket6) {
+ if ($addr_family == AF_INET6) {
+ die("!!! IO::Socket::INET6 and Socket6 modules are not found\nIPv6 support is not available\n");
+ }
+ if (not $missing_modules_ok) {
+ warn("!!! IO::Socket::INET6 -- optional module not found\n");
+ warn("!!! Socket6 -- optional module not found\n");
+ warn("!!! These modules are required for IPv6 support\n\n");
+ $missing_modules_count += 2;
+ }
+}
+
+## MIME::Lite dependency is optional
+my $mime_lite = eval { require MIME::Lite; 1; };
+if (not $mime_lite and not $missing_modules_ok) {
+ warn("!!! MIME::Lite -- optional module not found\n");
+ warn("!!! Used for composing messages from --subject, --body, --attachment, etc.\n\n");
+ $missing_modules_count++;
+}
+
+## File::Type dependency is optional
+my $file_type = eval { require File::Type; File::Type->new(); };
+if (not $file_type and not $missing_modules_ok) {
+ warn("!!! File::Type -- optional module not found\n");
+ warn("!!! Used for guessing MIME types of attachments\n\n");
+ $missing_modules_count++;
+}
+
+## Term::ReadKey dependency is optional
+my $have_term_readkey = eval { require Term::ReadKey; 1; };
+if (not $have_term_readkey and not $missing_modules_ok) {
+ warn("!!! Term::ReadKey -- optional module not found\n");
+ warn("!!! Used for hidden reading SMTP password from the terminal\n\n");
+ $missing_modules_count++;
+}
+
+my $have_hmac_md5 = eval { require Digest::HMAC_MD5; 1; };
+if (not $have_hmac_md5 and not $missing_modules_ok) {
+ if ($use_cram_md5) {
+ die("!!! CRAM-MD5 authentication is not available because Digest::HMAC_MD5 module is missing\n");
+ }
+ warn("!!! Digest::HMAC_MD5 -- optional module missing\n");
+ warn("!!! Used for CRAM-MD5 authentication method\n");
+ $missing_modules_count++;
+}
+
+## Advise about --missing-modules-ok parameter
+if ($missing_modules_count) {
+ warn("!!! Use --missing-modules-ok if you don't need the above listed modules\n");
+ warn("!!! and don't want to see this message again.\n\n");
+}
+
+## Accept hostname with port number as host:port
+if ($host =~ /^(.*):(.*)$/)
+{
+ $host = $1;
+ $port = $2;
+}
+
+# Build the MIME message if required
+if (defined($subject) or defined($body_plain) or defined($body_html) or
+ defined(@attachments) or defined(@attachments_inline)) {
+ if (not $mime_lite) {
+ die("Module MIME::Lite is not available. Unable to build the message, sorry.\n".
+ "Use --data and provide a complete email payload including headers instead.\n");
+ }
+ if (defined($datasrc)) {
+ die("Requested building a message and at the same time used --data parameter.\n".
+ "That's not possible, sorry.\n");
+ }
+ if (defined($body_plain) and -f $body_plain) {
+ local $/=undef;
+ open(FILE, $body_plain);
+ $body_plain = <FILE>;
+ close(FILE);
+ }
+ if (defined($body_html) and -f $body_html) {
+ local $/=undef;
+ open(FILE, $body_html);
+ $body_html = <FILE>;
+ close(FILE);
+ }
+ my $message = &build_message();
+
+ open(BUILT_MESSAGE, "+>", \$built_message);
+ $datasrc = "///built_message";
+ if ($print_only) {
+ $message->print();
+ exit(0);
+ } else {
+ $message->print(\*BUILT_MESSAGE);
+ }
+ seek(BUILT_MESSAGE, 0, 0);
+}
+
+# Username was given -> enable AUTH
+if ($user)
+ { $auth_ok = 1; }
+
+# If at least one --auth-* option was given, enable AUTH.
+if ($use_login + $use_plain + $use_cram_md5 > 0)
+ { $auth_ok = 1; }
+
+# If --enable-auth was given, enable all AUTH methods.
+elsif ($auth_ok && ($use_login + $use_plain + $use_cram_md5 == 0))
+{
+ $use_login = 1;
+ $use_plain = 1;
+ $use_cram_md5 = 1 if ($have_hmac_md5);
+}
+
+# Exit if user haven't specified username for AUTH.
+if ($auth_ok && !defined ($user))
+ { die ("SMTP AUTH support requested without --user\n"); }
+
+# Ask for password if it wasn't supplied on the command line.
+if ($auth_ok && defined ($user) && !defined ($pass))
+{
+ if ($have_term_readkey) {
+ # Set echo off.
+ Term::ReadKey::ReadMode (2);
+ } else {
+ warn ("Module Term::ReadKey not available - password WILL NOT be hidden!!!\n");
+ }
+ printf ("Enter password for %s@%s : ", $user, $host);
+ $pass = <>;
+ if ($have_term_readkey) {
+ # Restore echo.
+ Term::ReadKey::ReadMode (0);
+ printf ("\n");
+ }
+ exit if (! defined ($pass));
+ chop ($pass);
+}
+
+# Connect to the SMTP server.
+my %connect_args = (
+ PeerAddr => $host,
+ PeerPort => $port,
+ Proto => 'tcp',
+ Timeout => 5);
+if ($socket6) {
+ $connect_args{'Domain'} = $addr_family;
+ $sock = IO::Socket::INET6->new(%connect_args) or die ("Connect failed: $@\n");
+} else {
+ $sock = IO::Socket::INET->new(%connect_args) or die ("Connect failed: $@\n");
+}
+
+if ($verbose >= 1) {
+ my $addr_fmt = "%s";
+ $addr_fmt = "[%s]" if ($sock->sockhost() =~ /:/); ## IPv6 connection
+
+ printf ("Connection from $addr_fmt:%s to $addr_fmt:%s\n",
+ $sock->sockhost(), $sock->sockport(),
+ $sock->peerhost(), $sock->peerport());
+}
+
+my ($code, $text);
+my (%features);
+
+# Wait for the welcome message of the server.
+($code, $text) = &get_line ($sock);
+die ("Unknown welcome string: '$code $text'\n") if ($code != 220);
+$ehlo_ok-- if ($text !~ /ESMTP/);
+
+# Send EHLO
+&say_hello ($sock, $ehlo_ok, $hello_host, \%features) or exit (1);
+
+# Run the SMTP session
+&run_smtp ();
+
+# Good bye...
+&send_line ($sock, "QUIT\n");
+($code, $text) = &get_line ($sock);
+die ("Unknown QUIT response '$code'.\n") if ($code != 221);
+
+exit 0;
+
+# This is the main SMTP "engine".
+sub run_smtp
+{
+ # See if we could start encryption
+ if ((defined ($features{'STARTTLS'}) || defined ($features{'TLS'})) && $starttls_ok && !$have_ssl)
+ {
+ warn ("Module IO::Socket::SSL is missing - STARTTLS support disabled.\n");
+ warn ("Use --disable-starttls or install the modules to avoid this warning.\n");
+ undef ($features{'STARTTLS'});
+ undef ($features{'TLS'});
+ }
+
+ if ((defined ($features{'STARTTLS'}) || defined ($features{'TLS'})) && $starttls_ok)
+ {
+ printf ("Starting TLS...\n") if ($verbose >= 1);
+
+ # Do Net::SSLeay initialization
+ Net::SSLeay::load_error_strings();
+ Net::SSLeay::SSLeay_add_ssl_algorithms();
+ Net::SSLeay::randomize();
+
+ &send_line ($sock, "STARTTLS\n");
+ ($code, $text) = &get_line ($sock);
+ die ("Unknown STARTTLS response '$code'.\n") if ($code != 220);
+
+ if (! IO::Socket::SSL::socket_to_SSL($sock,
+ SSL_version => 'SSLv3 TLSv1'))
+ {
+ die ("STARTTLS: ".IO::Socket::SSL::errstr()."\n");
+ }
+
+ if ($verbose >= 1)
+ {
+ printf ("Using cipher: %s\n", $sock->get_cipher ());
+ printf ("%s", $sock->dump_peer_certificate());
+ }
+
+ # Send EHLO again (required by the SMTP standard).
+ &say_hello ($sock, $ehlo_ok, $hello_host, \%features) or return 0;
+ }
+
+ # See if we should authenticate ourself
+ if (defined ($features{'AUTH'}) && $auth_ok)
+ {
+ printf ("AUTH method (%s): ", $features{'AUTH'}) if ($verbose >= 1);
+
+ ## Try DIGEST-MD5 first
+ # Actually we won't. It never worked reliably here.
+ # After all DIGEST-MD5 is on a way to deprecation
+ # see this thread: http://www.imc.org/ietf-sasl/mail-archive/msg02996.html
+
+ # Instead use CRAM-MD5 if supported by the server
+ if ($features{'AUTH'} =~ /CRAM-MD5/i && $use_cram_md5)
+ {
+ printf ("using CRAM-MD5\n") if ($verbose >= 1);
+ &send_line ($sock, "AUTH CRAM-MD5\n");
+ ($code, $text) = &get_line ($sock);
+ if ($code != 334)
+ { die ("AUTH CRAM-MD5 failed: $code $text\n"); }
+
+ my $response = &encode_cram_md5 ($text, $user, $pass);
+ &send_line ($sock, "%s\n", $response);
+ ($code, $text) = &get_line ($sock);
+ if ($code != 235)
+ { die ("AUTH CRAM-MD5 failed: $code $text\n"); }
+ }
+ # Eventually try LOGIN method
+ elsif ($features{'AUTH'} =~ /LOGIN/i && $use_login)
+ {
+ printf ("using LOGIN\n") if ($verbose >= 1);
+ &send_line ($sock, "AUTH LOGIN\n");
+ ($code, $text) = &get_line ($sock);
+ if ($code != 334)
+ { die ("AUTH LOGIN failed: $code $text\n"); }
+
+ &send_line ($sock, "%s\n", encode_base64 ($user, ""));
+
+ ($code, $text) = &get_line ($sock);
+ if ($code != 334)
+ { die ("AUTH LOGIN failed: $code $text\n"); }
+
+ &send_line ($sock, "%s\n", encode_base64 ($pass, ""));
+
+ ($code, $text) = &get_line ($sock);
+ if ($code != 235)
+ { die ("AUTH LOGIN failed: $code $text\n"); }
+ }
+ # Or finally PLAIN if nothing else was supported.
+ elsif ($features{'AUTH'} =~ /PLAIN/i && $use_plain)
+ {
+ printf ("using PLAIN\n") if ($verbose >= 1);
+ &send_line ($sock, "AUTH PLAIN %s\n",
+ encode_base64 ("$user\0$user\0$pass", ""));
+ ($code, $text) = &get_line ($sock);
+ if ($code != 235)
+ { die ("AUTH PLAIN failed: $code $text\n"); }
+ }
+ # Complain otherwise.
+ else
+ {
+ warn ("No supported authentication method\n".
+ "advertised by the server.\n");
+ return 0;
+ }
+
+ printf ("Authentication of $user\@$host succeeded\n") if ($verbose >= 1);
+ }
+
+ # We can do a relay-test now if a recipient was set.
+ if ($#to >= 0)
+ {
+ if (!defined ($from))
+ {
+ warn ("From: address not set. Using empty one.\n");
+ $from = "";
+ }
+ &send_line ($sock, "MAIL FROM: <%s>\n", $from);
+ ($code, $text) = &get_line ($sock);
+ if ($code != 250)
+ {
+ warn ("MAIL FROM failed: '$code $text'\n");
+ return 0;
+ }
+
+ my $i;
+ for ($i=0; $i <= $#to; $i++)
+ {
+ &send_line ($sock, "RCPT TO: <%s>\n", $to[$i]);
+ ($code, $text) = &get_line ($sock);
+ if ($code != 250)
+ {
+ warn ("RCPT TO <".$to[$i]."> ".
+ "failed: '$code $text'\n");
+ return 0;
+ }
+ }
+ }
+
+ # Wow, we should even send something!
+ if (defined ($datasrc))
+ {
+ if ($datasrc eq "///built_message")
+ {
+ *MAIL = *BUILT_MESSAGE;
+ }
+ elsif ($datasrc eq "-")
+ {
+ *MAIL = *STDIN;
+ }
+ elsif (!open (MAIL, $datasrc))
+ {
+ warn ("Can't open file '$datasrc'\n");
+ return 0;
+ }
+
+ &send_line ($sock, "DATA\n");
+ ($code, $text) = &get_line ($sock);
+ if ($code != 354)
+ {
+ warn ("DATA failed: '$code $text'\n");
+ return 0;
+ }
+
+ while (<MAIL>)
+ {
+ my $line = $_;
+ $line =~ s/^\.$CRLF$/\. $CRLF/;
+ $line =~ s/^\.\n$/\. $CRLF/;
+ $sock->print ($line);
+ }
+
+ close (MAIL);
+
+ $sock->printf ("$CRLF.$CRLF");
+
+ ($code, $text) = &get_line ($sock);
+ if ($code != 250)
+ {
+ warn ("DATA not send: '$code $text'\n");
+ return 0;
+ }
+ }
+
+ # Perfect. Everything succeeded!
+ return 1;
+}
+
+# Get one line of response from the server.
+sub get_one_line ($)
+{
+ my $sock = shift;
+ my ($code, $sep, $text) = ($sock->getline() =~ /(\d+)(.)([^\r]*)/);
+ my $more;
+ $more = ($sep eq "-");
+ if ($verbose)
+ { printf ("[%d] '%s'\n", $code, $text); }
+ return ($code, $text, $more);
+}
+
+# Get concatenated lines of response from the server.
+sub get_line ($)
+{
+ my $sock = shift;
+ my ($code, $text, $more) = &get_one_line ($sock);
+ while ($more) {
+ my ($code2, $line);
+ ($code2, $line, $more) = &get_one_line ($sock);
+ $text .= " $line";
+ die ("Error code changed from $code to $code2. That's illegal.\n") if ($code ne $code2);
+ }
+ return ($code, $text);
+}
+
+# Send one line back to the server
+sub send_line ($@)
+{
+ my $socket = shift;
+ my @args = @_;
+
+ if ($verbose)
+ { printf ("> "); printf (@args); }
+ $args[0] =~ s/\n/$CRLF/g;
+ $socket->printf (@args);
+}
+
+# Helper function to encode CRAM-MD5 challenge
+sub encode_cram_md5 ($$$)
+{
+ my ($ticket64, $username, $password) = @_;
+ my $ticket = decode_base64($ticket64) or
+ die ("Unable to decode Base64 encoded string '$ticket64'\n");
+
+ print "Decoded CRAM-MD5 challenge: $ticket\n" if ($verbose > 1);
+ my $password_md5 = Digest::HMAC_MD5::hmac_md5_hex($ticket, $password);
+ return encode_base64 ("$username $password_md5", "");
+}
+
+# Store all server's ESMTP features to a hash.
+sub say_hello ($$$$)
+{
+ my ($sock, $ehlo_ok, $hello_host, $featref) = @_;
+ my ($feat, $param);
+ my $hello_cmd = $ehlo_ok > 0 ? "EHLO" : "HELO";
+
+ &send_line ($sock, "$hello_cmd $hello_host\n");
+ my ($code, $text, $more) = &get_one_line ($sock);
+
+ if ($code != 250)
+ {
+ warn ("$hello_cmd failed: '$code $text'\n");
+ return 0;
+ }
+
+ # Empty the hash
+ %{$featref} = ();
+
+ ($feat, $param) = ($text =~ /^(\w+)[= ]*(.*)$/);
+ $featref->{$feat} = $param;
+
+ # Load all features presented by the server into the hash
+ while ($more == 1)
+ {
+ ($code, $text, $more) = &get_one_line ($sock);
+ ($feat, $param) = ($text =~ /^(\w+)[= ]*(.*)$/);
+ $featref->{$feat} = $param;
+ }
+
+ return 1;
+}
+
+sub guess_mime_type($)
+{
+ my $filename = shift;
+ if (defined($file_type)) {
+ ## Use File::Type if possible
+ return $file_type->mime_type($filename);
+ } else {
+ ## Module File::Type is not available
+ ## Still recognise some common extensions
+ return "image/jpeg" if ($filename =~ /\.jpe?g/i);
+ return "image/gif" if ($filename =~ /\.gif/i);
+ return "image/png" if ($filename =~ /\.png/i);
+ return "text/plain" if ($filename =~ /\.txt/i);
+ return "application/zip" if ($filename =~ /\.zip/i);
+ return "application/x-gzip" if ($filename =~ /\.t?gz/i);
+ return "application/x-bzip" if ($filename =~ /\.t?bz2?/i);
+ }
+ return "application/octet-stream";
+}
+
+sub basename($)
+{
+ my $path = shift;
+ my @parts = split(/\//, $path);
+ return $parts[$#parts];
+}
+
+sub prepare_attachment($)
+{
+ my $attachment = shift;
+ my ($path, $mime_type);
+
+ if (-f $attachment) {
+ $path = $attachment;
+ $mime_type = guess_mime_type($attachment);
+ } elsif ($attachment =~ /(.*)@([^@]*)$/ and -f $1) {
+ $path = $1;
+ $mime_type = $2;
+ }
+ return ($path, $mime_type);
+}
+
+sub attach_attachments($@)
+{
+ my $message = shift;
+ my @attachments = @_;
+
+ foreach my $attachment (@attachments) {
+ my ($path, $mime_type) = prepare_attachment($attachment);
+ if (not defined($path)) {
+ warn("$attachment: File not found. Ignoring.\n");
+ next;
+ }
+ $message->attach(
+ Type => $mime_type,
+ Path => $path,
+ Id => basename($path),
+ );
+ }
+}
+
+sub safe_attach($$)
+{
+ my ($message, $part) = @_;
+ ## Remove some headers when $part is becoming a subpart of $message
+ $part->delete("Date");
+ $part->delete("X-Mailer");
+ $part->attr("MIME-Version" => undef);
+ $message->attach($part);
+ return $message;
+}
+
+sub mime_message($$)
+{
+ my ($type, $data) = @_;
+ ## MIME::Lite doesn't allow setting Type and Data once the
+ ## object is created. Well, maybe it does but I don't know how.
+ my $message = MIME::Lite->new(
+ Type => $type,
+ Data => $data);
+ return $message;
+}
+
+sub build_message
+{
+ my ($part_plain, $part_html, $part_body, $message);
+
+ if (defined(@attachments_inline)) {
+ if (not defined($body_html)) {
+ die("Inline attachments (--attach-inline) must be used with --body-html\n");
+ }
+ $part_html = MIME::Lite->new(Type => 'multipart/related');
+ $part_html->attach(Type => 'text/html', Data => $body_html);
+ attach_attachments($part_html, @attachments_inline);
+ $message = $part_html;
+ # undefine $body_html to prevent confusion in the next if()
+ undef($body_html);
+ }
+
+ if (defined($body_html)) {
+ $part_html = MIME::Lite->new(Type => 'text/html', Data => $body_html);
+ $message = $part_html;
+ }
+
+ if (defined($body_plain)) {
+ $part_plain = MIME::Lite->new(Type => "TEXT", Data => $body_plain);
+ $message = $part_plain;
+ }
+
+ if (defined($part_plain) and defined($part_html)) {
+ $part_body = mime_message("multipart/alternative", undef);
+ safe_attach($part_body, $part_plain);
+ safe_attach($part_body, $part_html);
+ $message = $part_body;
+ }
+
+ if (defined(@attachments)) {
+ if (defined($message)) {
+ # We already have some plaintext and/or html content built
+ # => make it the first part of multipart/mixed
+ my $message_body = $message;
+ $message = mime_message("multipart/mixed", undef);
+ safe_attach($message, $message_body);
+ attach_attachments($message, @attachments);
+ } elsif ($#attachments == 0) {
+ # Only one single attachment - let it be the body
+ my ($path, $mime_type) = prepare_attachment($attachments[0]);
+ if (not defined($path)) {
+ die($attachments[0].": File not found. No other message parts defined. Aborting.\n");
+ }
+ $message = MIME::Lite->new(
+ Type => $mime_type,
+ Path => $path);
+ } else {
+ # Message consisting only of attachments
+ $message = mime_message("multipart/mixed", undef);
+ attach_attachments($message, @attachments);
+ }
+ }
+
+ # Last resort - empty plaintext message
+ if (!defined($message)) {
+ $message = mime_message("TEXT", "");
+ }
+
+ $message->replace("From" => $from);
+ $message->replace("To" => join(", ", @to));
+ $message->replace("Subject" => $subject);
+ $message->replace("X-Mailer" => "smtp-cli $version, see http://smtp-cli.logix.cz");
+ $message->replace("Message-ID" => time()."-".int(rand(999999))."\@smtp-cli");
+ return $message;
+}
+
+sub version ()
+{
+ print "smtp-cli version $version\n";
+ exit (0);
+}
+
+sub usage ()
+{
+ printf (
+"Simple SMTP client written in Perl that supports advanced
+features like STARTTLS and SMTP-AUTH and IPv6. It can also
+create messages from components (files, text snippets) and
+attach files.
+
+Version: smtp-cli v$version
+
+Author: Michal Ludvig <michal\@logix.cz> (c) 2003-2009
+ http://smtp-cli.logix.cz
+
+Usage: smtp-cli [--options]
+
+ --host=<hostname> Host name or address of the SMTP server.
+ (default: localhost)
+ --port=<number> Port where the SMTP server is listening.
+ (default: 25)
+
+ -4 or --ipv4 Use standard IP (IPv4) protocol.
+ -6 or --ipv6 Use IPv6 protocol. For hosts that have
+ both IPv6 and IPv4 addresses the IPv6
+ connection is tried first.
+
+ --hello-host=<string> String to use in the EHLO/HELO command.
+ --disable-ehlo Don't use ESMTP EHLO command, only HELO.
+ --force-ehlo Use EHLO even if server doesn't say ESMTP.
+
+ Transport encryption (TLS)
+ --disable-starttls Don't use encryption even if the remote
+ host offers it.
+
+ Authentication options (AUTH)
+ --user=<username> Username for SMTP authentication.
+ --pass=<password> Corresponding password.
+ --auth-login Enable only AUTH LOGIN method.
+ --auth-plain Enable only AUTH PLAIN method.
+ --auth-cram-md5 Enable only AUTH CRAM-MD5 method.
+ --auth Enable all supported methods. This is
+ normally not needed, --user enables
+ everything as well.
+
+ Sender / recipient
+ --from=<address> Address to use in MAIL FROM command.
+ --to=<address> Address to use in RCPT TO command. Can be
+ used multiple times.
+
+ Send a complete RFC822-compliant email message:
+ --data=<filename> Name of file to send after DATA command.
+ With \"--data=-\" the script will read
+ standard input (useful e.g. for pipes).
+
+ Alternatively build email a message from provided components:
+ --subject=<subject> Subject of the message
+ --body-plain=<text|filename>
+ --body-html=<text|filename>
+ Plaintext and/or HTML body of the message
+ If both are provided the message is sent
+ as multipart.
+ --attach=<filename>[\@<MIME/Type>]
+ Attach a given filename.
+ MIME-Type of the attachment is guessed
+ by default guessed but can optionally
+ be specified after '\@' delimiter.
+ For instance: --attach mail.log\@text/plain
+ Parameter can be used multiple times.
+ --attach-inline=<filename>[\@<MIME/Type>]
+ Attach a given filename (typically a picture)
+ as a 'related' part to the above 'body-html'.
+ Refer to these pictures as <img src='cid:filename'>
+ in the 'body-html' contents.
+ See --attach for details about MIME-Type.
+ Can be used multiple times.
+ --print-only Dump the composed MIME message to standard
+ output. This is useful mainly for debugging
+ or in the case you need to run the message
+ through some filter before sending.
+
+ Other options
+ --verbose[=<number>] Be more verbose, print the SMTP session.
+ --missing-modules-ok Don't complain about missing optional modules.
+ --version Print: smtp-cli version $version
+ --help Guess what is this option for ;-)
+");
+ exit (0);
+}
+