add 3 more files

Signed-off-by: Florian Pritz <bluewind@xssn.at>

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);
+}
+