diff --git a/Maintenance/svn_client/config b/Maintenance/svn_client/config deleted file mode 100644 index e5abb49c881..00000000000 --- a/Maintenance/svn_client/config +++ /dev/null @@ -1,282 +0,0 @@ -### On Unix-like systems, put this file in ~/.subversion folder. -### -### On Win32 systems, put this file in -### C:\Document and Settings\username\Application data\Subversion folder -### (by the way, Application Data is usually a hidden directory). -### -### This file configures various client-side behaviors. -### -### The commented-out examples below are intended to demonstrate -### how to use this file. - -### Section for authentication and authorization customizations. -[auth] -### Set store-passwords to 'no' to avoid storing passwords in the -### auth/ area of your config directory. It defaults to 'yes'. -### Note that this option only prevents saving of *new* passwords; -### it doesn't invalidate existing passwords. (To do that, remove -### the cache files by hand as described in the Subversion book.) -# store-passwords = no -### Set store-auth-creds to 'no' to avoid storing any subversion -### credentials in the auth/ area of your config directory. -### It defaults to 'yes'. Note that this option only prevents -### saving of *new* credentials; it doesn't invalidate existing -### caches. (To do that, remove the cache files by hand.) -# store-auth-creds = no - -### Section for configuring external helper applications. -[helpers] -### Set editor to the command used to invoke your text editor. -### This will override the environment variables that Subversion -### examines by default to find this information ($EDITOR, -### et al). -# editor-cmd = editor (vi, emacs, notepad, etc.) -### Set diff-cmd to the absolute path of your 'diff' program. -### This will override the compile-time default, which is to use -### Subversion's internal diff implementation. -# diff-cmd = diff_program (diff, gdiff, etc.) -### Set diff3-cmd to the absolute path of your 'diff3' program. -### This will override the compile-time default, which is to use -### Subversion's internal diff3 implementation. -# diff3-cmd = diff3_program (diff3, gdiff3, etc.) -### Set diff3-has-program-arg to 'true' or 'yes' if your 'diff3' -### program accepts the '--diff-program' option. -# diff3-has-program-arg = [true | false] - -### Section for configuring tunnel agents. -[tunnels] -### Configure svn protocol tunnel schemes here. By default, only -### the 'ssh' scheme is defined. You can define other schemes to -### be used with 'svn+scheme://hostname/path' URLs. A scheme -### definition is simply a command, optionally prefixed by an -### environment variable name which can override the command if it -### is defined. The command (or environment variable) may contain -### arguments, using standard shell quoting for arguments with -### spaces. The command will be invoked as: -### svnserve -t -### (If the URL includes a username, then the hostname will be -### passed to the tunnel agent as @.) If the -### built-in ssh scheme were not predefined, it could be defined -### as: -# ssh = $SVN_SSH ssh -### If you wanted to define a new 'rsh' scheme, to be used with -### 'svn+rsh:' URLs, you could do so as follows: -# rsh = rsh -### Or, if you wanted to specify a full path and arguments: -# rsh = /path/to/rsh -l myusername -### On Windows, if you are specifying a full path to a command, -### use a forward slash (/) or a paired backslash (\\) as the -### path separator. A single backslash will be treated as an -### escape for the following character. - -### Section for configuring miscelleneous Subversion options. -[miscellany] - -## Set global-ignores to a set of whitespace-delimited globs -## which Subversion will ignore in its 'status' output. -global-ignores = *.bak *.bk? *.old .DS_Store *.a *.o *.lib *.dll *.exe *.so *.so.* debug release Debug Release x64 *.blg *.cgallog *.aux *.maf *.hax *.hlg *.ilg *.pdflg *.log *.toc *.cgallog.tmp* *.inc *.dvi *.mtc* *.idx ProgramOutput* ErrorOutput* CompilerOutput* error.txt *.ncb *.suo contents.obv .xvpics semantic.cache doc_ps doc_html doc_pdf *.moc .*~ *~ .#* *.user *.aps doc_doxygen CMakeCache.txt CMakeFiles cmake_install.cmake Doxyfile *.dir ALL_BUILD.vcproj ZERO_CHECK.vcproj gmon.* .qglviewer.xml *.moc_parameters *.cpp_parameters *_moc.cpp ui_*.h qrc_*.cxx *.sbr .dir-locals.el *.tmp *.ilk *.pdb *.exe.* Makefile *.cpp.noheader *.h.noheader *.h.filename *.cpp.filename .scm-urls *.exp *.resource.txt *.manifest *.manifest.res *.vcproj *.sln *.depends - -### Set log-encoding to the default encoding for log messages -# log-encoding = latin1 -### Set use-commit-times to make checkout/update/switch/revert -### put last-committed timestamps on every file touched. -# use-commit-times = yes -### Set no-unlock to prevent 'svn commit' from automatically -### releasing locks on files. -# no-unlock = yes - -## Set enable-auto-props to 'yes' to enable automatic properties -## for 'svn add' and 'svn import', it defaults to 'no'. -## Automatic properties are defined in the section 'auto-props'. -enable-auto-props = yes - -### Section for configuring automatic properties. -### The format of the entries is: -### file-name-pattern = propname[=value][;propname[=value]...] -### The file-name-pattern can contain wildcards (such as '*' and '?'). -### Caveat: file-name-patterns are case insensitive but you cannot have 2 rules -### that differ only by case. Workaround: use [] in pattern (not at start of line!). -### All entries which match will be applied to the file. -### -### Set property "svn:eol-style=native" for text files (default is binary). -### Set "svn:keywords=Author Date Id Revision URL" for text files (default is binary). -### Set "svn:executable" for Unix executable files. -### Set "svn:mime-type" for binary files (else SVN will attempt to guess this property). -[auto-props] - -# Plain text formats -*.txt = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.hlp = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -dont_submit = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -AUTHORS = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -maintainer = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -README = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -LICENSE = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -TODO = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -TO_DO = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -INSTALL = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -INSTALLATION = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -COPYRIGHT = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -KNOWN_PROBLEMS = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -NOTICE = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -COPYING = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -CHANGES = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.win32 = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.MacOSX = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.log = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.cfg = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.config = svn:eol-style=native;svn:keywords=Author Date Id Revision URL - -# HTML formats -*.htm = svn:eol-style=native;svn:keywords=Author Date Id Revision URL;svn:mime-type=text/html -*.html = svn:eol-style=native;svn:keywords=Author Date Id Revision URL;svn:mime-type=text/html -*.shtml = svn:eol-style=native;svn:keywords=Author Date Id Revision URL;svn:mime-type=text/html -*.xml = svn:eol-style=native;svn:keywords=Author Date Id Revision URL;svn:mime-type=text/xml -*.xsl = svn:eol-style=native;svn:keywords=Author Date Id Revision URL;svn:mime-type=text/xml -*.css = svn:eol-style=native;svn:keywords=Author Date Id Revision URL;svn:mime-type=text/css -*.dtd = svn:eol-style=native;svn:keywords=Author Date Id Revision URL; svn:mime-type=text/xml -.htaccess = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -.htgroup = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -.htpasswd = svn:eol-style=native;svn:keywords=Author Date Id Revision URL - -# Latex formats -*.tex = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.inputs = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.bib = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.bst = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.sty = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.fd = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.aw = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.awi = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.lw = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.nw = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.fw = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.fwi = svn:eol-style=native;svn:keywords=Author Date Id Revision URL - -# Script formats -*.sh = svn:eol-style=LF;svn:keywords=Author Date Id Revision URL;svn:executable -*.csh = svn:eol-style=LF;svn:keywords=Author Date Id Revision URL;svn:executable -*.bat = svn:eol-style=CRLF;svn:keywords=Author Date Id Revision URL -*.run = svn:eol-style=native;svn:keywords=Author Date Id Revision URL;svn:executable -*.pl = svn:eol-style=native;svn:keywords=Author Date Id Revision URL;svn:executable -*.pm = svn:eol-style=native;svn:keywords=Author Date Id Revision URL;svn:executable -*.py = svn:eol-style=native;svn:keywords=Author Date Id Revision URL;svn:executable -cgal_test_with_cmake = svn:eol-style=LF;svn:keywords=Author Date Id Revision URL;svn:executable -*.cmd = svn:eol-style=LF;svn:keywords=Author Date Id Revision URL -*.dpatch = svn:eol-style=native;svn:keywords=Author Date Id Revision URL;svn:executable - -# Code formats -*.[cC] = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.cpp = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.cxx = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.xpm = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.cc = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.tcc = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.stage_* = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.h = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.hpp = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.inl = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.ipp = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.tcc = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.f = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.m = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.mema = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.y = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.lex = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -makefile = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -makefile.* = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -makefile_* = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -Make[Ff]ile = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -Make[Ff]ile.* = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -Make[Ff]ile_* = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.[Mm]akefile = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -GNUmakefile = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -Makefilevc = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.mak = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.mk = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.kdevelop = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.kdevelop.filelist = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.kdevses = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.kdevelop.pcs = svn:mime-type=application/octet-stream -*.dsp = svn:eol-style=CRLF;svn:keywords=Author Date Id Revision URL -*.dsw = svn:eol-style=CRLF;svn:keywords=Author Date Id Revision URL -*.vcproj = svn:eol-style=CRLF;svn:keywords=Author Date Id Revision URL -*.vc = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.sln = svn:eol-style=CRLF;svn:keywords=Author Date Id Revision URL -*.suo = svn:mime-type=application/octet-stream -*.def = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.rc = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.rc2 = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.reg = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.manifest = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.ini = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.dxy = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -Doxyfile = svn:eol-style=native;svn:keywords=Author Date Id Revision URL - -# Image formats -*.png = svn:mime-type=image/png -*.gif = svn:mime-type=image/gif -*.icns = svn:mime-type=application/octet-stream -*.jpg = svn:mime-type=image/jpeg -*.jpeg = svn:mime-type=image/jpeg -*.bmp = svn:mime-type=image/bmp -*.ico = svn:mime-type=image/x-icon -*.tif = svn:mime-type=image/tiff -*.tiff = svn:mime-type=image/tiff -*.pcx = svn:mime-type=application/octet-stream -*.xbm = svn:mime-type=application/octet-stream -*.ppm = svn:mime-type=application/octet-stream -*.fig = svn:mime-type=application/octet-stream -*.xfig = svn:mime-type=application/octet-stream -*.ltex = svn:mime-type=application/octet-stream - -# Meshes and 3D formats -*.off = svn:mime-type=application/octet-stream -*.obj = svn:mime-type=application/octet-stream -*.mtl = svn:mime-type=application/octet-stream -*.dxf = svn:mime-type=application/octet-stream -*.poly = svn:mime-type=application/octet-stream -*.mesh = svn:mime-type=application/octet-stream -*.nef = svn:mime-type=application/octet-stream -*.nef3 = svn:mime-type=application/octet-stream -*.spheres = svn:mime-type=application/octet-stream - -# Postscript formats -*.pdf = svn:mime-type=application/pdf -*.ai = svn:mime-type=application/postscript -*.eps = svn:mime-type=application/postscript -*.ps = svn:mime-type=application/postscript -*.pstex = svn:mime-type=application/postscript -*.pstex_t = svn:mime-type=application/postscript -*.ipe = svn:mime-type=application/postscript -*.ips = svn:mime-type=application/postscript -*.plot = svn:mime-type=application/postscript - -# Binary executables -*.dll = svn:mime-type=application/octet-stream -*.a = svn:mime-type=application/octet-stream -*.o = svn:mime-type=application/octet-stream -*.so = svn:mime-type=application/octet-stream -*.lib = svn:mime-type=application/octet-stream -*.exe = svn:mime-type=application/octet-stream - -# Other text based data formats -*.mps = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.bff = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.spec = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.nsi = svn:eol-style=native;svn:keywords=Author Date Id Revision URL -*.patch = svn:mime-type=text/x-diff - -# Other binary data formats -*.gz = svn:mime-type=application/gzip -*.tgz = svn:mime-type=application/gzip -*.zip = svn:mime-type=application/zip -*.tar = svn:mime-type=application/octet-stream -*.odg = svn:mime-type=application/octet-stream -*.ppt = svn:mime-type=application/vnd.ms-powerpoint -*.doc = svn:mime-type=application/msword -*.rtf = svn:mime-type=application/rtf -*.mw = svn:mime-type=application/octet-stream -*.mws = svn:mime-type=application/octet-stream -*.sxw = svn:mime-type=application/octet-stream -*.pmproj = svn:mime-type=application/octet-stream diff --git a/Maintenance/svn_server/hooks/Mail/Sender.pm b/Maintenance/svn_server/hooks/Mail/Sender.pm deleted file mode 100755 index 35ca6f696b6..00000000000 --- a/Maintenance/svn_server/hooks/Mail/Sender.pm +++ /dev/null @@ -1,3501 +0,0 @@ -# Mail::Sender.pm version 0.8.13 -# -# Copyright (c) 2001 Jan Krynicky . All rights reserved. -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. - -package Mail::Sender; local $^W; -require 'Exporter.pm'; -use vars qw(@ISA @EXPORT @EXPORT_OK); -@ISA = (Exporter); -@EXPORT = qw(); -@EXPORT_OK = qw(@error_str GuessCType); - -$Mail::Sender::VERSION = '0.8.16'; -$Mail::Sender::ver=$Mail::Sender::VERSION; - -BEGIN { - if ($] >= 5.008) { - # fsck, the 5.8 is broken. The binmode() doesn't work for socket()s. - require 'open.pm'; - 'open'->import(OUT=>":raw :perlio"); - } -} - -use strict; -use warnings; -no warnings 'uninitialized'; -use Carp; -use FileHandle; -use IO::Socket::INET; -use File::Basename; - -use MIME::Base64; -use MIME::QuotedPrint; - # if you do not use MailFile or SendFile and only send 7BIT or 8BIT "encoded" - # messages you may comment out these lines. - #MIME::Base64 and MIME::QuotedPrint may be found at CPAN. - -# include config file and libraries when packaging the script -if (0) { - require 'Mail/Sender.config'; # local configuration - require 'Symbol.pm'; # for debuging and GetHandle() method - require 'Tie/Handle.pm'; # for debuging and GetHandle() method - require 'IO/Handle.pm'; # for debuging and GetHandle() method - require 'Digest/HMAC_MD5.pm'; # for CRAM-MD5 authentication only - require 'Authen/NTLM.pm'; # for NTLM authentication only -} # this block above is there to let PAR, PerlApp, PerlCtrl, PerlSvc and Perl2Exe know I may need those files. - -BEGIN { - my $config = $INC{'Mail/Sender.pm'}; - die "Wrong case in use statement or Mail::Sender module renamed. Perl is case sensitive!!!\n" unless $config; - my $compiled = !(-e $config); # if the module was not read from disk => the script has been "compiled" - $config =~ s/\.pm$/.config/; - if ($compiled or -e $config) { - # in a Perl2Exe or PerlApp created executable or PerlCtrl generated COM object - # or the config is known to exist - eval {require $config}; - if ($@ and $@ !~ /Can't locate /) { - print STDERR "Error in Mail::Sender.config : $@" ; - } - } -} - -#local IP address and name -my $local_name = $ENV{HOSTNAME} || $ENV{HTTP_HOST} || (gethostbyname 'localhost')[0]; -$local_name =~ s/:.*$//; # the HTTP_HOST may be set to something like "foo.bar.com:1000" -my $local_IP = join('.',unpack('CCCC',(gethostbyname $local_name)[4])); - -#time diference to GMT - Windows will not set $ENV{'TZ'}, if you know a better way ... -my $GMTdiff; - -use Time::Local; -sub ResetGMTdiff { - my $local = time; - my $gm = timelocal( gmtime $local ); - my $sign = qw( + + - )[ $local <=> $gm ]; - $GMTdiff = sprintf "%s%02d%02d", $sign, (gmtime abs( $local - $gm ))[2,1]; -} -ResetGMTdiff(); - -# -my @priority = ('','1 (Highest)','2 (High)', '3 (Normal)','4 (Low)','5 (Lowest)'); - -#data encoding -my $chunksize=1024*4; -my $chunksize64=71*57; # must be divisible by 57 ! - -sub enc_base64 {my $s = encode_base64($_[0]); $s =~ s/\x0A/\x0D\x0A/sg; return $s;} -my $enc_base64_chunk = 57; - -sub enc_qp {my $s = $_[0];$s =~ s/\x0D\x0A/\n/g;$s = encode_qp($s); $s=~s/^\./../gm; $s =~ s/\x0A/\x0D\x0A/sg; return $s} - -sub enc_plain {my $s = shift; $s=~s/^\./../gm; $s =~ s/(?:\x0D\x0A?|\x0A)/\x0D\x0A/sg; return $s} - -{ my $username; -sub getusername () { - return $username if defined($username); - return $username=eval{getlogin || getpwuid($<)} || $ENV{USERNAME}; -} -} - -#IO -use vars qw($debug); -$debug = 0; - -#reads the whole SMTP response -# converts -# nnn-very -# nnn-long -# nnn message -# to -# nnn very -# long -# message -sub get_response ($) { - my $s = shift; - my $res = <$s>; - if ($res =~ s/^(\d\d\d)-/$1 /) { - my $nextline = <$s>; - while ($nextline =~ s/^\d\d\d-//) { - $res .= $nextline; - $nextline = <$s>; - } - $nextline =~ s/^\d\d\d //; - $res .= $nextline; - } - $Mail::Sender::LastResponse = $res; - return $res; -} - -sub send_cmd ($$) { - my ($s, $cmd) = @_; - chomp $cmd; - if ($s->opened()) { - print $s "$cmd\x0D\x0A"; - get_response($s); - } else { - return '400 connection lost'; - } -} - -sub print_hdr { - my ($s, $hdr, $str, $charset) = @_; - return if !defined $str or $str eq ''; - $str =~ s/[\x0D\x0A\s]+$//; - - if ($charset && $str =~ /[^[:ascii:]]/) { - $str = encode_qp($str); - $str =~ s/=\r?\n$//; - $str = "=?$charset?Q?" . $str . "?="; - } - - $str =~ s/(?:\x0D\x0A?|\x0A)/\x0D\x0A/sg; # \n or \r => \r\n - $str =~ s/\x0D\x0A([^\t])/\x0D\x0A\t$1/sg; - if (length($str)+length($hdr) > 997) { # header too long, max 1000 chars - $str =~ s/(.{1,997}[;,])\s+/$1\x0D\x0A\t/g; - } - print $s "$hdr: $str\x0D\x0A"; -} - - -sub say_helo { - my ($self, $s) = @_; - my $res = send_cmd $s, "EHLO $self->{'client'}"; - if ($res !~ /^[123]/) { - $res = send_cmd $s, "HELO $self->{'client'}"; - if ($res !~ /^[123]/) { return $self->Error(COMMERROR($_));} - return; - } - - $res =~ s/^.*\n//; - $self->{'supports'} = {map {split /\s+/, $_, 2} split /\n/, $res}; - - if (exists $self->{'supports'}{AUTH}) { - my @auth = split /\s+/, uc($self->{'supports'}{AUTH}); - $self->{'auth_protocols'} = {map {$_, 1} @auth}; - # create a hash with accepted authentication protocols - } - - $self->{esmtp}{_MAIL_FROM} = ''; - $self->{esmtp}{_RCPT_TO} = ''; - if (exists $self->{'supports'}{DSN} and exists $self->{esmtp}) { - for (qw(RET ENVID)) { - $self->{esmtp}{_MAIL_FROM} .= " $_=$self->{esmtp}{$_}" - if $self->{esmtp}{$_} ne ''; - } - for (qw(NOTIFY ORCPT)) { - $self->{esmtp}{_RCPT_TO} .= " $_=$self->{esmtp}{$_}" - if $self->{esmtp}{$_} ne ''; - } - } - return; -} - -sub login { - my $self = shift(); - my $auth = uc( $self->{'auth'}) || 'LOGIN'; - if (! $self->{'auth_protocols'}->{$auth}) { - return $self->Error(INVALIDAUTH($auth)); - } - - $self->{'authid'} = $self->{'username'} - if (exists $self->{'username'} and !exists $self->{'authid'}); - - $self->{'authpwd'} = $self->{'password'} - if (exists $self->{'password'} and !exists $self->{'authpwd'}); - - $auth =~ tr/a-zA-Z0-9_/_/c; # change all characters except letters, numbers and underscores to underscores - no strict qw'subs refs'; - &{"Mail::Sender::Auth::".$auth}($self); -} - -# authentication code stolen from http://support.zeitform.de/techinfo/e-mail_prot.html -sub Mail::Sender::Auth::LOGIN { - my $self = shift(); - my $s = $self->{'socket'}; - - $_ = send_cmd $s, 'AUTH LOGIN'; - if (!/^[123]/) { return $self->Error(INVALIDAUTH('LOGIN', $_)); } - - if ($self->{auth_encoded}) { - # I assume the username and password had been base64 encoded already! - $_ = send_cmd $s, $self->{'authid'}; - if (!/^[123]/) { return $self->Error(LOGINERROR($_)); } - - $_ = send_cmd $s, $self->{'authpwd'}; - if (!/^[123]/) { return $self->Error(LOGINERROR($_)); } - } else { - $_ = send_cmd $s, &encode_base64($self->{'authid'}); - if (!/^[123]/) { return $self->Error(LOGINERROR($_)); } - - $_ = send_cmd $s, &encode_base64($self->{'authpwd'}); - if (!/^[123]/) { return $self->Error(LOGINERROR($_)); } - } - return; -} - -use vars qw($MD5_loaded); -$MD5_loaded = 0; -sub Mail::Sender::Auth::CRAM_MD5 { - my $self = shift(); - my $s = $self->{'socket'}; - - $_ = send_cmd $s, "AUTH CRAM-MD5"; - if (!/^[123]/) { return $self->Error(INVALIDAUTH('CRAM-MD5', $_)); } - my $stamp = $1 if /^\d{3}\s+(.*)$/; - - unless ($MD5_loaded) { - eval 'use Digest::HMAC_MD5 qw(hmac_md5_hex)'; - die "$@\n" if $@; - $MD5_loaded = 1; - } - - my $user = $self->{'authid'}; - my $secret = $self->{'authpwd'}; - - my $decoded_stamp = decode_base64($stamp); - my $hmac = hmac_md5_hex($decoded_stamp, $secret); - my $answer = encode_base64($user . ' ' . $hmac); - $_ = send_cmd $s, $answer; - if (!/^[123]/) { return $self->Error(LOGINERROR($_)); } - return; -} - -sub Mail::Sender::Auth::PLAIN { - my $self = shift(); - my $s = $self->{'socket'}; - - $_ = send_cmd $s, "AUTH PLAIN"; - if (!/^[123]/) { return $self->Error(INVALIDAUTH('PLAIN', $_)); } - - $_ = send_cmd $s, encode_base64("\000" . $self->{'authid'} . "\000" . $self->{'authpwd'}); - if (!/^[123]/) { return $self->Error(LOGINERROR($_)); } - return; -} - -{ -my $NTLM_loaded=0; -sub Mail::Sender::Auth::NTLM { - unless ($NTLM_loaded) { - eval "use Authen::NTLM qw();"; - die "$@\n" if $@; - $NTLM_loaded = 1; - } - my $self = shift(); - my $s = $self->{'socket'}; - - $_ = send_cmd $s, "AUTH NTLM"; - if (!/^[123]/) { return $self->Error(INVALIDAUTH('NTLM', $_)); } - - Authen::NTLM::ntlm_user($self->{'authid'}); - Authen::NTLM::ntlm_password($self->{'authpwd'}); - Authen::NTLM::ntlm_domain($self->{'authdomain'}) - if defined $self->{'authdomain'}; - - $_ = send_cmd $s, Authen::NTLM::ntlm(); - if (!/^3\d\d (.*)$/s) { return $self->Error(LOGINERROR($_)); } - my $response = $1; - $_ = send_cmd $s, Authen::NTLM::ntlm($response); - if (!/^[123]/) { return $self->Error(LOGINERROR($_)); } - return; -}} - -sub Mail::Sender::Auth::AUTOLOAD { - (my $auth = $Mail::Sender::Auth::AUTOLOAD) =~ s/.*:://; - my $self = shift(); - my $s = $self->{'socket'}; - send_cmd $s, "QUIT"; - close $s; - delete $self->{'socket'}; - return $self->Error( UNKNOWNAUTH($auth)); -} - -my $debug_code; -sub __Debug { - my ($socket, $file) = @_; - if (defined $file) { - unless (defined @Mail::Sender::DBIO::ISA) { - eval "use Symbol;"; - eval $debug_code; - die $@ if $@; - } - my $handle = gensym(); - *$handle = \$socket; - if (! ref $file) { - my $DEBUG = new FileHandle; - open $DEBUG, "> $file" or die "Cannot open the debug file '$file': $^E\n"; - binmode $DEBUG; - $DEBUG->autoflush(); - tie *$handle, 'Mail::Sender::DBIO', $socket, $DEBUG, 1; - } else { - my $DEBUG = $file; - tie *$handle, 'Mail::Sender::DBIO', $socket, $DEBUG, 0; - } - bless $handle, 'Mail::Sender::DBIO'; - return $handle; - } else { - return $socket; - } -} - -#internale - -sub HOSTNOTFOUND { - $!=2; - $Mail::Sender::Error="The SMTP server $_[0] was not found"; - return -1, $Mail::Sender::Error; -} - -sub SOCKFAILED { - $Mail::Sender::Error='socket() failed: $^E'; - $!=5; - return -2, $Mail::Sender::Error; -} - -sub CONNFAILED { - $Mail::Sender::Error="connect() failed: $^E"; - $!=5; - return -3, $Mail::Sender::Error; -} - -sub SERVNOTAVAIL { - $!=40; - $Mail::Sender::Error="Service not available. Reply: $_[0]"; - return -4, $Mail::Sender::Error; -} - -sub COMMERROR { - $!=5; - if ($_[0] eq '') { - $Mail::Sender::Error="No response from server"; - } else { - $Mail::Sender::Error="Server error: $_[0]"; - } - return -5, $Mail::Sender::Error; -} - -sub USERUNKNOWN { - $!=2; - if ($_[2] and $_[2] !~ /Local user/i) { - my $err= $_[2]; - $err =~ s/^\d+\s*//; - $err =~ s/\s*$//s; - $err ||= "Error"; - $Mail::Sender::Error="$err for \"$_[0]\" on host \"$_[1]\""; - } else { - $Mail::Sender::Error="Local user \"$_[0]\" unknown on host \"$_[1]\""; - } - return -6, $Mail::Sender::Error; -} - -sub TRANSFAILED { - $!=5; - $Mail::Sender::Error="Transmission of message failed ($_[0])"; - return -7, $Mail::Sender::Error; -} - -sub TOEMPTY { - $!=14; - $Mail::Sender::Error="Argument \$to empty"; - return -8, $Mail::Sender::Error; -} - -sub NOMSG { - $!=22; - $Mail::Sender::Error="No message specified"; - return -9, $Mail::Sender::Error; -} - -sub NOFILE { - $!=22; - $Mail::Sender::Error="No file name specified"; - return -10, $Mail::Sender::Error; -} - -sub FILENOTFOUND { - $!=2; - $Mail::Sender::Error="File \"$_[0]\" not found"; - return -11, $Mail::Sender::Error; -} - -sub NOTMULTIPART { - $!=40; - $Mail::Sender::Error="$_[0] not available in singlepart mode"; - return -12, $Mail::Sender::Error; -} - -sub SITEERROR { - $!=15; - $Mail::Sender::Error="Site specific error"; - return -13, $Mail::Sender::Error; -} - -sub NOTCONNECTED { - $!=1; - $Mail::Sender::Error="Connection not established"; - return -14, $Mail::Sender::Error; -} - -sub NOSERVER { - $!=22; - $Mail::Sender::Error="No SMTP server specified"; - return -15, $Mail::Sender::Error; -} - -sub NOFROMSPECIFIED { - $!=22; - $Mail::Sender::Error="No From: address specified"; - return -16, $Mail::Sender::Error; -} - -sub INVALIDAUTH { - $!=22; - $Mail::Sender::Error="Authentication protocol $_[0] is not accepted by the server"; - $Mail::Sender::Error.=",\nresponse: $_[1]" if defined $_[1]; - return -17, $Mail::Sender::Error; -} - -sub LOGINERROR { - $!=22; - $Mail::Sender::Error="Login not accepted"; - return -18, $Mail::Sender::Error; -} - -sub UNKNOWNAUTH { - $!=22; - $Mail::Sender::Error="Authentication protocol $_[0] is not implemented by Mail::Sender"; - return -19, $Mail::Sender::Error; -} - -sub ALLRECIPIENTSBAD { - $!=2; - return -20, $Mail::Sender::Error; -} - -sub FILECANTREAD { - $Mail::Sender::Error="File \"$_[0]\" cannot be read: $^E"; - return -21, $Mail::Sender::Error; -} - -sub DEBUGFILE { - $Mail::Sender::Error=$_[0]; - return -22, $Mail::Sender::Error; -} - -@Mail::Sender::Errors = ( - 'OK', - 'debug file cannot be opened', - 'file cannot be read', - 'all recipients have been rejected', - 'authentication protocol is not implemented', - 'login not accepted', - 'authentication protocol not accepted by the server', - 'no From: address specified', - 'no SMTP server specified', - 'connection not established. Did you mean MailFile instead of SendFile?', - 'site specific error', - 'not available in singlepart mode', - 'file not found', - 'no file name specified in call to MailFile or SendFile', - 'no message specified in call to MailMsg or MailFile', - 'argument $to empty', - 'transmission of message failed', - 'local user $to unknown on host $smtp', - 'unspecified communication error', - 'service not available', - 'connect() failed', - 'socket() failed', - '$smtphost unknown' -); - -=head1 NAME - -Mail::Sender - module for sending mails with attachments through an SMTP server - -Version 0.8.16 - -=head1 SYNOPSIS - - use Mail::Sender; - $sender = new Mail::Sender - {smtp => 'mail.yourdomain.com', from => 'your@address.com'}; - $sender->MailFile({to => 'some@address.com', - subject => 'Here is the file', - msg => "I'm sending you the list you wanted.", - file => 'filename.txt'}); - -=head1 DESCRIPTION - -C provides an object oriented interface to sending mails. -It doesn't need any outer program. It connects to a mail server -directly from Perl, using Socket. - -Sends mails directly from Perl through a socket connection. - -=head1 new Mail::Sender - - new Mail::Sender ([from [,replyto [,to [,smtp [,subject [,headers [,boundary]]]]]]]) - new Mail::Sender {[from => 'somebody@somewhere.com'] , [to => 'else@nowhere.com'] [...]} - -Prepares a sender. This doesn't start any connection to the server. You -have to use C<$Sender->Open> or C<$Sender->OpenMultipart> to start -talking to the server. - -The parameters are used in subsequent calls to C<$Sender->Open> and -C<$Sender->OpenMultipart>. Each such call changes the saved variables. -You can set C, C and other options here and then use the info -in all messages. - -=head2 Parameters - -=over 4 - -=item from - -C<>=> the sender's e-mail address - -=item fake_from - -C<>=> the address that will be shown in headers. - -If not specified we use the value of C. - -=item replyto - -C<>=> the reply-to address - -=item to - -C<>=> the recipient's address(es) - -This parameter may be either a comma separated list of email addresses -or a reference to a list of addresses. - -=item fake_to - -C<>=> the recipient's address that will be shown in headers. -If not specified we use the value of "to". - -If the list of addresses you want to send your message to is long or if you do not want -the recipients to see each other's address set the C parameter to some informative, -yet bogus, address or to the address of your mailing/distribution list. - -=item cc - -C<>=> address(es) to send a copy (CC:) to - -=item fake_cc - -C<>=> the address that will be shown in headers. - -If not specified we use the value of "cc". - -=item bcc - -C<>=> address(es) to send a copy (BCC: or blind carbon copy). -these addresses will not be visible in the mail! - -=item smtp - -C<>=> the IP or domain address of your SMTP (mail) server - -This is the name of your LOCAL mail server, do NOT try -to contact directly the adressee's mailserver! That would be slow and buggy, -your script should only pass the messages to the nearest mail server and leave -the rest to it. Keep in mind that the recipient's server may be down temporarily. - -=item port - -C<>=> the TCP/IP port used form the connection. By default getservbyname('smtp', 'tcp')||25. -You should only need to use this option if your mail server waits on a nonstandard port. - -=item subject - -C<>=> the subject of the message - -=item headers - -C<>=> the additional headers - -You may use this parameter to add custon headers into the message. The parameter may -be either a string containing the headers in the right format or a hash containing the headers -and their values. - -=item boundary - -C<>=> the message boundary - -You usualy do not have to change this, it might only come in handy if you need -to attach a multipart mail created by Mail::Sender to your message as a single part. -Even in that case any problems are unlikely. - -=item multipart - -C<>=> the MIME subtype for the whole message (Mixed/Related/Alternative) - -You may need to change this setting if you want to send a HTML body with some -inline images, or if you want to post the message in plain text as well as -HTML (alternative). See the examples at the end of the docs. -You may also use the nickname "subtype". - -Please keep in mind though that it's not currently possible to create nested parts with Mail::Sender. -If you need that level of control you should try MIME::Lite. - -=item ctype - -C<>=> the content type of a single part message - -Please do not confuse these two. The 'multipart' parameter is used to specify -the overall content type of a multipart message (for example a HTML document -with inlined images) while ctype is an ordinary content type for a single -part message. For example a HTML mail message without any inlines. - -=item encoding - -C<>=> encoding of a single part message or the body of a multipart message. - -If the text of the message contains some extended characters or -very long lines you should use 'encoding => "Quoted-printable"' in the -call to Open(), OpenMultipart(), MailMsg() or MailFile(). - -Keep in mind that if you use some encoding you should either use SendEnc() -or encode the data yourself ! - -=item charset - -C<>=> the charset of the message - -=item client - -C<>=> the name of the client computer. - -During the connection you send -the mailserver your computer's name. By default Mail::Sender sends -C<(gethostbyname 'localhost')[0]>. -If that is not the address you need, you can specify a different one. - -=item priority - -C<>=> the message priority number - -1 = highest, 2 = high, 3 = normal, 4 = low, 5 = lowest - -=item confirm - -C<>=> whether you request reading or delivery confirmations and to what addresses: - - "delivery" - only delivery, to the C address - "reading" - only reading, to the C address - "delivery, reading" - both confirmations, to the C address - "delivery: my.other@address.com" - only delivery, to my.other@address.com - ... - -Keep in mind though that neither of those is guaranteed to work. Some servers/mail clients do not support -this feature and some users/admins may have disabled it. So it's possible that your mail was delivered and read, -but you wount get any confirmation! - -=item ESMPT - - ESMTP => { - NOTIFY => 'SUCCESS,FAILURE,DELAY', - RET => 'HDRS', - ORCPT => 'rfc822;my.other@address.com', - ENVID => 'iuhsdfobwoe8t237', - } - -This option contains data for SMTP extensions, for example it allows you to request delivery -status notifications according to RFC1891. - -NOTIFY - to specify the conditions under which a delivery status notification should be generated. -Should be either "NEVER" or a comma separated list of "SUCCESS", "FAILURE" and "DELAY". - -ORCPT - used to convey the "original" (sender-specified) recipient address - -RET - to request that Delivery Status Notifications containing an indication of delivery -failure either return the entire contents of a message or only the message headers. Must be either -FULL or HDRS - -ENVID - used to propagate an identifier for this message transmission envelope, which is also -known to the sender and will, if present, be returned in any Delivery Status Notifications issued -for this transmission - -You do not need to worry about encoding the ORCPT or ENVID parameters. - -If the SMTP server you connect to doesn't support this extension, the options will be ignored. - -=item debug - -C<>=> C<"/path/to/debug/file.txt"> - -or - -C<>=> \*FILEHANDLE - -or - -C<>=> $FH - -All the conversation with the server will be logged to that file or handle. -All lines in the file should end with CRLF (the Windows and Internet format). -If even a single one of them does not, please let me know! - -If you pass the path to the log file, Mail::Sender will overwrite it. If you want to append to the file, -you have to open it yourself and pass the filehandle: - - open my $DEBUG, ">> /path/to/debug/file.txt" - or die "Can't open the debug file: $!\n" - $sender = new Mail::Sender ({ - ... - debug => $DEBUG, - }); - -=item debug_level - -Only taken into account if the C option is specified. - - 1 - only log the conversation with the server, skip all message data - 2 - log the conversation and message headers - 3 - log the conversation and the message and part headers - 4 - log everything (default) - -=item auth - -the SMTP authentication protocol to use to login to the server -currently the only ones supported are LOGIN, PLAIN, CRAM-MD5 and NTLM. - -Some protocols have module dependencies. CRAM-MD5 depends on -Digest::HMAC_MD5 and NTLM on Authen::NTLM. - -You may add support for other authentication protocols yourself. See below. - -=item authid - -the username used to login to the server - -=item authpwd - -the password used to login to the server - -=item authdomain - -the domain name. Used optionaly by the NTLM authentication. - -Other authentication protocols may use other options as well. -They should all start with "auth" though. - -Please see the authentication section bellow. - -=item auth_encoded - -If set to a true value the LOGIN authentication assumes the authid and authpwd -is already base64 encoded. - -=item keepconnection - -If set to a true value causes the Mail::Sender to keep the connection open for several messages. -The connection will be closed if you call the Close() method with a true value or if you call Open, -OpenMultipart, MailMsg or MailFile with the "smtp" parameter. -This means that if you want the object to keep the connection you should pass the "smtp" either to "new Mail::Sender" -or only to the first Open, OpenMultipart, MailMsg or MailFile! - -=item skip_bad_recipients - -If this option is set to false or not specified then Mail::Sender stops trying to send a message as soon as -the first recipient's address fails. If it is set to a true value Mail::Sender skips the bad addresses and tries -to send the message at least to the good ones. If all addresses are rejected by the server it reports an -"All recipients were rejected" message. - -If any addresses were skipped the C<$sender-E{'skipped_recipients'}> will be a reference to a hash -containing the failed address and the server's response. - -=item createmessageid - -This option allows you to overwrite the function that generates the message IDs for the emails. -The function gets the "pure" sender's address as it's only parameter and is supposed to return a string. -See the MessageID subroutine in Mail::Sender.pm. - -If you want to specify a message id you can also use the "messageid" parameter for the Open, OpenMultipart, -MailMsg or MailFile methods. - -=item on_errors - -This option allows you to affect the way Mail::Sender reports errors. - - => 'die' - raise an exception - => 'code' - return the negative error code (default) - => 'undef' - return an undef - -$Mail::Sender::Error, $sender->{'error'} and $sender->{'error_msg'} are set in all the cases. - -All methods return the $sender object if they succeed. - -P.S.: The die_on_errors option is deprecated. You may still use it, but it may be removed in future versions! - -=back - -=head2 Return codes - - ref to a Mail::Sender object = success - - -1 = $smtphost unknown - -2 = socket() failed - -3 = connect() failed - -4 = service not available - -5 = unspecified communication error - -6 = local user $to unknown on host $smtp - -7 = transmission of message failed - -8 = argument $to empty - -9 = no message specified in call to MailMsg or MailFile - -10 = no file name specified in call to SendFile or MailFile - -11 = file not found - -12 = not available in singlepart mode - -13 = site specific error - -14 = connection not established. Did you mean MailFile instead of SendFile? - -15 = no SMTP server specified - -16 = no From: address specified - -17 = authentication protocol not accepted by the server - -18 = login not accepted - -19 = authentication protocol is not implemented - -$Mail::Sender::Error contains a textual description of last error. - -=cut - -sub new { - my $this = shift; - my $self = {}; - my $class; - if (ref($this)) { - $class = ref($this); - %$self = %$this; - } else { - $class = $this; - } - bless $self, $class; - return $self->initialize(@_); -} - -sub initialize { - undef $Mail::Sender::Error; - my $self = shift; - - delete $self->{'_buffer'}; - $self->{'debug'} = 0; - $self->{'proto'} = (getprotobyname('tcp'))[2]; - $self->{'port'} = getservbyname('smtp', 'tcp')||25 if not defined $self->{'port'}; - - $self->{'boundary'} = 'Message-Boundary-by-Mail-Sender-'.time(); - $self->{'multipart'} = 'mixed'; # default is multipart/mixed - - $self->{'client'} = $local_name; - - # Copy defaults from %Mail::Sender::default - my $key; - foreach $key (keys %Mail::Sender::default) { - $self->{lc $key}=$Mail::Sender::default{$key}; - } - - if (@_ != 0) { - if (ref $_[0] eq 'HASH') { - my $hash=$_[0]; - foreach $key (keys %$hash) { - $self->{lc $key}=$hash->{$key}; - } - $self->{'reply'} = $self->{'replyto'} if (defined $self->{'replyto'} and !defined $self->{'reply'}); - } else { - ($self->{'from'}, $self->{'reply'}, $self->{'to'}, $self->{'smtp'}, - $self->{'subject'}, $self->{'headers'}, $self->{'boundary'} - ) = @_; - } - } - - $self->{'fromaddr'} = $self->{'from'}; - $self->{'replyaddr'} = $self->{'reply'}; - - $self->_prepare_addresses('to') if defined $self->{'to'}; - $self->_prepare_addresses('cc') if defined $self->{'cc'}; - $self->_prepare_addresses('bcc') if defined $self->{'bcc'}; - - $self->_prepare_ESMTP() if defined $self->{'esmtp'}; - - $self->{'fromaddr'} =~ s/.*<([^\s]*?)>/$1/ if ($self->{'fromaddr'}); # get from email address - if (defined $self->{'replyaddr'} and $self->{'replyaddr'}) { - $self->{'replyaddr'} =~ s/.*<([^\s]*?)>/$1/; # get reply email address - $self->{'replyaddr'} =~ s/^([^\s]+).*/$1/; # use first address - } - - if (defined $self->{'smtp'}) { - $self->{'smtp'} =~ s/^\s+//g; # remove spaces around $smtp - $self->{'smtp'} =~ s/\s+$//g; - - $self->{'smtpaddr'} = inet_aton($self->{'smtp'}); - if (!defined($self->{'smtpaddr'})) { return $self->Error(HOSTNOTFOUND($self->{'smtp'})); } - $self->{'smtpaddr'} = $1 if ($self->{'smtpaddr'} =~ /(.*)/s); # Untaint - } - - $self->{'boundary'} =~ tr/=/-/ if defined $self->{'boundary'}; - - $self->_prepare_headers() if (exists $self->{'headers'}); - - return $self; -} - -use vars qw(%CTypes); -%CTypes = ( - GIF => 'image/gif', - JPE => 'image/jpeg', - JPEG => 'image/jpeg', - SHTML => 'text/html', - SHTM => 'text/html', - HTML => 'text/html', - HTM => 'text/html', - TXT => 'text/plain', - INI => 'text/plain', - DOC => 'application/x-msword', - EML => 'message/rfc822', -); - -sub GuessCType { - my $ext = shift; - $ext =~ s/^.*\.//; - return $CTypes{uc $ext} || 'application/octet-stream'; -} - -sub Connect { - my $self = shift(); - - my $s = IO::Socket::INET->new( - PeerHost => $self->{'smtp'}, - PeerPort => $self->{'port'}, - Proto => "tcp", - Timeout => ($self->{'timeout'} || 120), - ) or return $self->Error(CONNFAILED); - - binmode($s) - unless ($] >= 5.008); - -### Test only!!! -#binmode($s, ":utf8"); -### - - $s->autoflush(1); - - if ($self->{'debug'}) { - eval { - $s = __Debug( $s, $self->{'debug'}); - } - or return $self->Error(DEBUGFILE($@)); - $self->{'debug_level'} = 4 unless defined $self->{'debug_level'}; - } - - $_ = get_response($s); if (not $_ or !/^[123]/) { return $self->Error(SERVNOTAVAIL($_)); } - $self->{'server'} = substr $_, 4; - - { my $res = $self->say_helo($s); - return $res if $res; - } - - if ($self->{'auth'} or $self->{'username'}) { - $self->{'socket'} = $s; - my $res = $self->login(); - return $res if $res; - delete $self->{'socket'}; # it's supposed to be added later - } - - return $s; -} - -sub Error { - my $self = shift(); - if (@_) { - if (defined $self->{'socket'}) { - my $s = $self->{'socket'}; - print $s "quit\x0D\x0A"; - close $s; - delete $self->{'socket'}; - } - delete $self->{'_data'}; - ($self->{'error'},$self->{'error_msg'}) = @_; - } - if ($self->{'die_on_errors'} or $self->{'on_errors'} eq 'die') { - die $self->{'error_msg'}."\n" ; - } elsif (exists $self->{'on_errors'} and (!defined($self->{'on_errors'}) or $self->{'on_errors'} eq 'undef')) { - return - } else { - return $self->{'error'} - } -} - -sub ClearErrors { - my $self = shift(); - delete $self->{'error'}; - delete $self->{'error_msg'}; - undef $Mail::Sender::Error; -} - -sub _prepare_addresses { - my ($self, $type) = @_; - if (ref $self->{$type}) { - $self->{$type.'_list'} = $self->{$type}; - $self->{$type} = join ', ', @{$self->{$type.'_list'}}; - } else { - $self->{$type} =~ s/\s+/ /g; - $self->{$type} =~ s/, ?,/,/g; - $self->{$type.'_list'} = [map {s/\s+$//;$_} $self->{$type} =~ /((?:[^",]+|"[^"]*")+)(?:,\s*|\s*$)/g]; - } -} - -sub _prepare_ESMTP { - my $self = shift; - $self->{esmtp} = {%{$self->{esmtp}}}; # make a copy of the hash. Just in case - - $self->{esmtp}{ORCPT} = 'rfc822;' . $self->{esmtp}{ORCPT} if $self->{esmtp}{ORCPT} ne '' and $self->{esmtp}{ORCPT} !~ /;/; - for (qw(ENVID ORCPT)) { - $self->{esmtp}{$_} = encode_qp($self->{esmtp}{$_}) -# if $self->{esmtp}{$_} =~ /[\x00-\x20+=\x7E-\xFFFF]/; -# if $self->{esmtp}{$_} =~ /[^\x21-\x2A\x2C-\x3C\x3E-\x7E]/; # anything between ! (\x21) and ~ (\x7E) except + and = - if $self->{esmtp}{$_} =~ /[^!-~]/; # anything between ! (\x21) and ~ (\x7E) - } -} - -sub _prepare_headers { - my $self = shift; - return unless exists $self->{'headers'}; - if ($self->{'headers'} eq '') { - delete $self->{'headers'}; - return; - } - for ($self->{'headers'}) { - if (ref($self->{'headers'}) eq 'HASH') { - my $headers = ''; - while ( my ($hdr, $value) = each %{$self->{'headers'}}) { - for ($hdr, $value) { - s/(?:\x0D\x0A?|\x0A)/\x0D\x0A/sg; # convert all end-of-lines to CRLF - s/^(?:\x0D\x0A)+//; # strip leading - s/(?:\x0D\x0A)+$//; # and trailing end-of-lines - s/\x0D\x0A(\S)/\x0D\x0A\t$1/sg; - } - $headers .= "$hdr: $value\x0D\x0A"; - } - $headers =~ s/(?:\x0D\x0A)+$//; # and trailing end-of-lines - $self->{'headers'} = $headers; - } elsif (ref($self->{'headers'})) { - } else { - s/(?:\x0D\x0A?|\x0A)/\x0D\x0A/sg; # convert all end-of-lines to CRLF - s/^(?:\x0D\x0A)+//; # strip leading - s/(?:\x0D\x0A)+$//; # and trailing end-of-lines - } - } -} -=head1 METHODS - - -=head2 Open - - Open([from [, replyto [, to [, smtp [, subject [, headers]]]]]]) - Open({[from => "somebody@somewhere.com"] , [to => "else@nowhere.com"] [...]}) - -Opens a new message. If some parameters are unspecified or empty, it uses -the parameters passed to the "C<$Sender=new Mail::Sender(...)>"; - -See C for info about the parameters. - -The only additional parameter that may not be specified directly in the C -is messageid. If you set this option then the message will be sent with this Message-ID, -otherwise a new Message ID will be generated out of the sender's address, current date+time -and a random number (or by the function you specified in the C option). - -After the message is sent C<$sender-E{messageid}> will contain the Message-ID with -which the message was sent. - -Returns ref to the Mail::Sender object if successfull. - -=cut - -sub Open { - undef $Mail::Sender::Error; - my $self = shift; - local $_; - if (!$self->{'keepconnection'} and $self->{'_data'}) { # the user did not Close() or Cancel() the previous mail - if ($self->{'error'}) { - $self->Cancel; - } else { - $self->Close; - } - } - - delete $self->{'error'}; - delete $self->{'encoding'}; - delete $self->{'messageid'}; - my %changed; - $self->{'multipart'} = 0; - $self->{'_had_newline'} = 1; - - if (ref $_[0] eq 'HASH') { - my $key; - my $hash=$_[0]; - $hash->{'reply'} = $hash->{'replyto'} if (defined $hash->{'replyto'} and !defined $hash->{'reply'}); - foreach $key (keys %$hash) { - if (ref($hash->{$key}) eq 'HASH' and exists $self->{lc $key}) { - $self->{lc $key} = { %{$self->{lc $key}}, %{$hash->{$key}} }; - } else { - $self->{lc $key} = $hash->{$key}; - } - $changed{lc $key}=1; - } - } else { - my ($from, $reply, $to, $smtp, $subject, $headers) = @_; - - if ($from) {$self->{'from'}=$from;$changed{'from'}=1;} - if ($reply) {$self->{'reply'}=$reply;$changed{'reply'}=1;} - if ($to) {$self->{'to'}=$to;$changed{'to'}=1;} - if ($smtp) {$self->{'smtp'}=$smtp;$changed{'smtp'}=1;} - if ($subject) {$self->{'subject'}=$subject;$changed{'subject'}=1;} - if ($headers) {$self->{'headers'}=$headers;$changed{'headers'}=1;} - } - - $self->_prepare_addresses('to') if $changed{'to'}; - $self->_prepare_addresses('cc') if $changed{'cc'}; - $self->_prepare_addresses('bcc') if $changed{'bcc'}; - - $self->_prepare_ESMTP() if defined $changed{'esmtp'}; - - $self->{'boundary'} =~ tr/=/-/ if defined $changed{'boundary'}; - - return $self->Error( NOFROMSPECIFIED) unless defined $self->{'from'}; - - if ($changed{'from'}) { - $self->{'fromaddr'} = $self->{'from'}; - $self->{'fromaddr'} =~ s/.*<([^\s]*?)>/$1/; # get from email address - } - - if ($changed{'reply'}) { - $self->{'replyaddr'} = $self->{'reply'}; - $self->{'replyaddr'} =~ s/.*<([^\s]*?)>/$1/; # get reply email address - $self->{'replyaddr'} =~ s/^([^\s]+).*/$1/; # use first address - } - - if ($changed{'smtp'}) { - $self->{'smtp'} =~ s/^\s+//g; # remove spaces around $smtp - $self->{'smtp'} =~ s/\s+$//g; - $self->{'smtpaddr'} = inet_aton($self->{'smtp'}); - if (!defined($self->{'smtpaddr'})) { return $self->Error(HOSTNOTFOUND($self->{'smtp'})); } - $self->{'smtpaddr'} = $1 if ($self->{'smtpaddr'} =~ /(.*)/s); # Untaint - if (exists $self->{'socket'}) { - my $s = $self->{'socket'}; - close $s; - delete $self->{'socket'}; - } - } - - $self->_prepare_headers() if ($changed{'headers'}); - - if (!$self->{'to'}) { return $self->Error(TOEMPTY); } - - return $self->Error(NOSERVER) unless defined $self->{'smtp'}; -# if (!defined($self->{'smtpaddr'})) { return $self->Error(HOSTNOTFOUND($self->{'smtp'})); } - - if ($Mail::Sender::{'SiteHook'} and !$self->SiteHook()) { - return defined $self->{'error'} ? $self->{'error'} : $self->{'error'}=&SITEERROR; - } - - my $s = $self->{'socket'} || $self->Connect(); - return $s unless ref $s; # return the error number if we did not get a socket - $self->{'socket'} = $s; - - $_ = send_cmd $s, "MAIL FROM:<$self->{'fromaddr'}>$self->{esmtp}{_MAIL_FROM}"; - if (!/^[123]/) { return $self->Error(COMMERROR($_)); } - - { local $^W; - if ($self->{'skip_bad_recipients'}) { - my $good_count = 0; - my %failed; - foreach my $addr ( @{$self->{'to_list'}}, @{$self->{'cc_list'}}, @{$self->{'bcc_list'}}) { - if ($addr =~ /<(.*)>/) { - $_ = send_cmd $s, "RCPT TO:<$1>$self->{esmtp}{_RCPT_TO}"; - } else { - $_ = send_cmd $s, "RCPT TO:<$addr>$self->{esmtp}{_RCPT_TO}"; - } - if (!/^[123]/) { - chomp; - s/^\d{3} //; - $failed{$addr} = $_; - } else { - $good_count++ - } - } - $self->{'skipped_recipients'} = \%failed - if %failed; - if ($good_count == 0) { - return $self->Error(ALLRECIPIENTSBAD); - } - } else { - foreach my $addr ( @{$self->{'to_list'}}, @{$self->{'cc_list'}}, @{$self->{'bcc_list'}}) { - if ($addr =~ /<(.*)>/) { - $_ = send_cmd $s, "RCPT TO:<$1>$self->{esmtp}{_RCPT_TO}"; - } else { - $_ = send_cmd $s, "RCPT TO:<$addr>$self->{esmtp}{_RCPT_TO}"; - } - if (!/^[123]/) { - return $self->Error(USERUNKNOWN($addr, $self->{'smtp'}, $_)); } - } - } - } - - $_ = send_cmd $s, "DATA"; - if (!/^[123]/) { return $self->Error(COMMERROR($_)); } - - $self->{'socket'}->stop_logging("\x0D\x0A... message headers and data skipped ...") if ($self->{'debug'} and $self->{'debug_level'} <= 1); - $self->{'_data'} = 1; - - $self->{'ctype'} = 'text/plain' if (defined $self->{'charset'} and !defined $self->{'ctype'}); - - my $headers; - if (defined $self->{'encoding'} or defined $self->{'ctype'}) { - $headers = 'MIME-Version: 1.0'; - $headers .= "\r\nContent-type: $self->{'ctype'}" if defined $self->{'ctype'}; - $headers .= "; charset=$self->{'charset'}" if defined $self->{'charset'}; - - undef $self->{'chunk_size'}; - if (defined $self->{'encoding'}) { - $headers .= "\r\nContent-transfer-encoding: $self->{'encoding'}"; - if ($self->{'encoding'} =~ /Base64/i) { - $self->{'code'}=\&enc_base64; - $self->{'chunk_size'} = $enc_base64_chunk; - } elsif ($self->{'encoding'} =~ /Quoted[_\-]print/i) { - $self->{'code'}=\&enc_qp; - } - } - } - $self->{'code'}=\&enc_plain unless $self->{'code'}; - - print_hdr $s, "To" => (defined $self->{'fake_to'} ? $self->{'fake_to'} : $self->{'to'}), $self->{'charset'}; - print_hdr $s, "From" => (defined $self->{'fake_from'} ? $self->{'fake_from'} : $self->{'from'}), $self->{'charset'}; - if (defined $self->{'fake_cc'} and $self->{'fake_cc'}) { - print_hdr $s, "Cc" => $self->{'fake_cc'}, $self->{'charset'}; - } elsif (defined $self->{'cc'} and $self->{'cc'}) { - print_hdr $s, "Cc" => $self->{'cc'}, $self->{'charset'}; - } - print_hdr $s, "Reply-to", $self->{'reply'},$self->{'charset'} if defined $self->{'reply'}; - - $self->{'subject'} = "" unless defined $self->{'subject'}; - print_hdr $s, "Subject" => $self->{'subject'}, $self->{'charset'}; - - unless (defined $Mail::Sender::NO_DATE and $Mail::Sender::NO_DATE) { - my $date = localtime(); $date =~ s/^(\w+)\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)$/$1, $3 $2 $5 $4/; - print_hdr $s, "Date" => "$date $GMTdiff"; - } - - if ($self->{'priority'}) { - $self->{'priority'} = $priority[$self->{'priority'}] - if ($self->{'priority'}+0 eq $self->{'priority'}); - print_hdr $s, "X-Priority" => $self->{'priority'}; - } - - if ($self->{'confirm'}) { - for my $confirm (split /\s*,\s*/, $self->{'confirm'}) { - if ($confirm =~ /^\s*reading\s*(?:\:\s*(.*))?/i) { - print_hdr $s, "X-Confirm-Reading-To" => ($1 || $self->{'from'}), $self->{'charset'}; - } elsif ($confirm =~ /^\s*delivery\s*(?:\:\s*(.*))?/i) { - print_hdr $s, "Return-receipt-to" => ($1 || $self->{'fromaddr'}), $self->{'charset'}; - } - } - } - - unless (defined $Mail::Sender::NO_X_MAILER) { - my $script = basename($0); - print_hdr $s, "X-Mailer" => qq{Perl script "$script"\r\n\tusing Mail::Sender $Mail::Sender::ver by Jenda Krynicky, Czechlands\r\n\trunning on $local_name ($local_IP)\r\n\tunder account "}.getusername().qq{"\r\n} - } - - unless (defined $Mail::Sender::NO_MESSAGE_ID and $Mail::Sender::NO_MESSAGE_ID) { - if (!defined $self->{'messageid'} or $self->{'messageid'} eq '') { - if (defined $self->{'createmessageid'} and ref $self->{'createmessageid'} eq 'CODE') { - $self->{'messageid'} = $self->{'createmessageid'}->($self->{'fromaddr'}); - } else { - $self->{'messageid'} = MessageID($self->{'fromaddr'}); - } - } - print_hdr $s, "Message-ID" => $self->{'messageid'}; - } - - print $s $Mail::Sender::SITE_HEADERS,"\x0D\x0A" # should handle \r\n at the end of the headers - if (defined $Mail::Sender::SITE_HEADERS); - - print $s $self->{'headers'},"\x0D\x0A" if defined $self->{'headers'} and $self->{'headers'}; - print $s $headers,"\r\n" if defined $headers; - - print $s "\r\n"; - - $self->{'socket'}->stop_logging("... message data skipped ...") if ($self->{'debug'} and $self->{'debug_level'} <= 2); - - return $self; -} - -=head2 OpenMultipart - - OpenMultipart([from [, replyto [, to [, smtp [, subject [, headers [, boundary]]]]]]]) - OpenMultipart({[from => "somebody@somewhere.com"] , [to => "else@nowhere.com"] [...]}) - -Opens a multipart message. If some parameters are unspecified or empty, it uses -the parameters passed to the C<$Sender=new Mail::Sender(...)>. - -See C for info about the parameters. - -Returns ref to the Mail::Sender object if successfull. - -=cut - -sub OpenMultipart { - undef $Mail::Sender::Error; - my $self = shift; - - local $_; - if (!$self->{'keepconnection'} and $self->{'_data'}) { # the user did not Close() or Cancel() the previous mail - if ($self->{'error'}) { - $self->Cancel; - } else { - $self->Close; - } - } - - delete $self->{'error'}; - delete $self->{'encoding'}; - delete $self->{'messageid'}; - $self->{'_part'} = 0; - - my %changed; - if (defined $self->{'type'} and $self->{'type'}) { - $self->{'multipart'} = $1 - if $self->{'type'} =~ m{^multipart/(.*)}i; - } - $self->{'multipart'} ='Mixed' unless $self->{'multipart'}; - $self->{'idcounter'} = 0; - - if (ref $_[0] eq 'HASH') { - my $key; - my $hash=$_[0]; - $hash->{'multipart'} = $hash->{'subtype'} if defined $hash->{'subtype'}; - $hash->{'reply'} = $hash->{'replyto'} if (defined $hash->{'replyto'} and !defined $hash->{'reply'}); - foreach $key (keys %$hash) { - if ((ref($hash->{$key}) eq 'HASH') and exists($self->{lc $key})) { - $self->{lc $key} = { %{$self->{lc $key}}, %{$hash->{$key}} }; - } else { - $self->{lc $key} = $hash->{$key}; - } - $changed{lc $key}=1; - } - } else { - my ($from, $reply, $to, $smtp, $subject, $headers, $boundary) = @_; - - if ($from) {$self->{'from'}=$from;$changed{'from'}=1;} - if ($reply) {$self->{'reply'}=$reply;$changed{'reply'}=1;} - if ($to) {$self->{'to'}=$to;$changed{'to'}=1;} - if ($smtp) {$self->{'smtp'}=$smtp;$changed{'smtp'}=1;} - if ($subject) {$self->{'subject'}=$subject;$changed{'subject'}=1;} - if ($headers) {$self->{'headers'}=$headers;$changed{'headers'}=1;} - if ($boundary) {$self->{'boundary'}=$boundary;} - } - - $self->_prepare_addresses('to') if $changed{'to'}; - $self->_prepare_addresses('cc') if $changed{'cc'}; - $self->_prepare_addresses('bcc') if $changed{'bcc'}; - - $self->_prepare_ESMTP() if defined $changed{'esmtp'}; - - $self->{'boundary'} =~ tr/=/-/ if $changed{'boundary'}; - - $self->_prepare_headers() if ($changed{'headers'}); - - return $self->Error( NOFROMSPECIFIED) unless defined $self->{'from'}; - if ($changed{'from'}) { - $self->{'fromaddr'} = $self->{'from'}; - $self->{'fromaddr'} =~ s/.*<([^\s]*?)>/$1/; # get from email address - } - - if ($changed{'reply'}) { - $self->{'replyaddr'} = $self->{'reply'}; - $self->{'replyaddr'} =~ s/.*<([^\s]*?)>/$1/; # get reply email address - $self->{'replyaddr'} =~ s/^([^\s]+).*/$1/; # use first address - } - - if ($changed{'smtp'}) { - $self->{'smtp'} =~ s/^\s+//g; # remove spaces around $smtp - $self->{'smtp'} =~ s/\s+$//g; - $self->{'smtpaddr'} = inet_aton($self->{'smtp'}); - if (!defined($self->{'smtpaddr'})) { return $self->Error(HOSTNOTFOUND($self->{'smtp'})); } - $self->{'smtpaddr'} = $1 if ($self->{'smtpaddr'} =~ /(.*)/s); # Untaint - if (exists $self->{'socket'}) { - my $s = $self->{'socket'}; - close $s; - delete $self->{'socket'}; - } - } - - if (!$self->{'to'}) { return $self->Error(TOEMPTY); } - - return $self->Error(NOSERVER) unless defined $self->{'smtp'}; -# if (!defined($self->{'smtpaddr'})) { return $self->Error(HOSTNOTFOUND($self->{'smtp'})); } - - if ($Mail::Sender::{'SiteHook'} and !$self->SiteHook()) { - return defined $self->{'error'} ? $self->{'error'} : $self->{'error'}=&SITEERROR; - } - - my $s = $self->{'socket'} || $self->Connect(); - return $s unless ref $s; # return the error number if we did not get a socket - $self->{'socket'} = $s; - - $_ = send_cmd $s, "MAIL FROM:<$self->{'fromaddr'}>$self->{esmtp}{_MAIL_FROM}"; - if (!/^[123]/) { return $self->Error(COMMERROR($_)); } - - { local $^W; - if ($self->{'skip_bad_recipients'}) { - my $good_count = 0; - my %failed; - foreach my $addr ( @{$self->{'to_list'}}, @{$self->{'cc_list'}}, @{$self->{'bcc_list'}}) { - if ($addr =~ /<(.*)>/) { - $_ = send_cmd $s, "RCPT TO:<$1>$self->{esmtp}{_RCPT_TO}"; - } else { - $_ = send_cmd $s, "RCPT TO:<$addr>$self->{esmtp}{_RCPT_TO}"; - } - if (!/^[123]/) { - s/^\d{3} //; - $failed{$addr} = $_; - } else { - $good_count++ - } - } - $self->{'skipped_recipients'} = \%failed - if %failed; - if ($good_count == 0) { - return $self->Error(ALLRECIPIENTSBAD); - } - } else { - foreach my $addr ( @{$self->{'to_list'}}, @{$self->{'cc_list'}}, @{$self->{'bcc_list'}}) { - if ($addr =~ /<(.*)>/) { - $_ = send_cmd $s, "RCPT TO:<$1>$self->{esmtp}{_RCPT_TO}"; - } else { - $_ = send_cmd $s, "RCPT TO:<$addr>$self->{esmtp}{_RCPT_TO}"; - } - if (!/^[123]/) { - return $self->Error(USERUNKNOWN($addr, $self->{'smtp'}, $_)); - } - } - } - } - - $_ = send_cmd $s, "DATA"; - if (!/^[123]/) { return $self->Error(COMMERROR($_)); } - - $self->{'socket'}->stop_logging("\x0D\x0A... message headers and data skipped ...") if ($self->{'debug'} and $self->{'debug_level'} <= 1); - $self->{'_data'} = 1; - - print_hdr $s, "To" => (defined $self->{'fake_to'} ? $self->{'fake_to'} : $self->{'to'}), $self->{'charset'}; - print_hdr $s, "From" => (defined $self->{'fake_from'} ? $self->{'fake_from'} : $self->{'from'}), $self->{'charset'}; - if (defined $self->{'fake_cc'} and $self->{'fake_cc'}) { - print_hdr $s, "Cc" => $self->{'fake_cc'}, $self->{'charset'}; - } elsif (defined $self->{'cc'} and $self->{'cc'}) { - print_hdr $s, "Cc" => $self->{'cc'}, $self->{'charset'}; - } - print_hdr $s, "Reply-to" => $self->{'reply'}, $self->{'charset'} if defined $self->{'reply'}; - - $self->{'subject'} = "" unless defined $self->{'subject'}; - print_hdr $s, "Subject" => $self->{'subject'}, $self->{'charset'}; - - unless (defined $Mail::Sender::NO_DATE and $Mail::Sender::NO_DATE) { - my $date = localtime(); $date =~ s/^(\w+)\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)$/$1, $3 $2 $5 $4/; - print_hdr $s, "Date" => "$date $GMTdiff"; - } - - if ($self->{'priority'}) { - $self->{'priority'} = $priority[$self->{'priority'}] - if ($self->{'priority'}+0 eq $self->{'priority'}); - print_hdr $s, "X-Priority" => $self->{'priority'}; - } - - if ($self->{'confirm'}) { - for my $confirm (split /\s*,\s*/, $self->{'confirm'}) { - if ($confirm =~ /^\s*reading\s*(?:\:\s*(.*))?/i) { - print_hdr $s, "X-Confirm-Reading-To" => ($1 || $self->{'from'}), $self->{'charset'}; - } elsif ($confirm =~ /^\s*delivery\s*(?:\:\s*(.*))?/i) { - print_hdr $s, "Return-receipt-to" => ($1 || $self->{'fromaddr'}), $self->{'charset'}; - } - } - } - - unless (defined $Mail::Sender::NO_X_MAILER and $Mail::Sender::NO_X_MAILER) { - my $script = basename($0); - print_hdr $s, "X-Mailer" => qq{Perl script "$script"\r\n\tusing Mail::Sender $Mail::Sender::ver by Jenda Krynicky, Czechlands\r\n\trunning on $local_name ($local_IP)\r\n\tunder account "}.getusername().qq{"\r\n} - } - - print $s $Mail::Sender::SITE_HEADERS,"\r\n" - if (defined $Mail::Sender::SITE_HEADERS); - - unless (defined $Mail::Sender::NO_MESSAGE_ID and $Mail::Sender::NO_MESSAGE_ID) { - if (!defined $self->{'messageid'} or $self->{'messageid'} eq '') { - if (defined $self->{'createmessageid'} and ref $self->{'createmessageid'} eq 'CODE') { - $self->{'messageid'} = $self->{'createmessageid'}->($self->{'fromaddr'}); - } else { - $self->{'messageid'} = MessageID($self->{'fromaddr'}); - } - } - print_hdr $s, "Message-ID" => $self->{'messageid'}; - } - - print $s $self->{'headers'},"\r\n" if defined $self->{'headers'} and $self->{'headers'}; - print $s "MIME-Version: 1.0\r\n"; - print_hdr $s, "Content-type", qq{multipart/$self->{'multipart'};\r\n\tboundary="$self->{'boundary'}"}; - - print $s "\r\n"; - $self->{'socket'}->stop_logging("... message data skipped ...") if ($self->{'debug'} and $self->{'debug_level'} <= 2); - - print $s "This message is in MIME format. Since your mail reader does not understand\r\n" - . "this format, some or all of this message may not be legible.\r\n" - . "\r\n--$self->{'boundary'}\r\n"; - - return $self; -} - -sub Connected { - my $self = shift(); - return unless exists $self->{'socket'}; - my $s = $self->{'socket'}; - return $s->opened(); -} - - - -=head2 MailMsg - - MailMsg([from [, replyto [, to [, smtp [, subject [, headers]]]]]], message) - MailMsg({[from => "somebody@somewhere.com"] - [, to => "else@nowhere.com"] [...], msg => "Message"}) - -Sends a message. If a mail in $sender is opened it gets closed -and a new mail is created and sent. $sender is then closed. -If some parameters are unspecified or empty, it uses -the parameters passed to the "C<$Sender=new Mail::Sender(...)>"; - -See C for info about the parameters. - -The module was made so that you could create an object initialized with -all the necesary options and then send several messages without need to -specify the SMTP server and others each time. If you need to send only -one mail using MailMsg() or MailFile() you do not have to create a named -object and then call the method. You may do it like this : - - (new Mail::Sender)->MailMsg({smtp => 'mail.company.com', ...}); - -Returns ref to the Mail::Sender object if successfull. - -=cut - -sub MailMsg { - my $self = shift; - my $msg; - local $_; - if (ref $_[0] eq 'HASH') { - my $hash=$_[0]; - $msg=$hash->{'msg'}; - } else { - $msg = pop; - } - return $self->Error(NOMSG) unless $msg; - - if (ref $self->Open(@_) - and - ref $self->SendEnc($msg) - and - ref $self->Close() - ) { - return $self - } else { - return $self->{'error'} - } -} - - -=head2 MailFile - - MailFile([from [, replyto [, to [, smtp [, subject [, headers]]]]]], message, file(s)) - MailFile({[from => "somebody@somewhere.com"] - [, to => "else@nowhere.com"] [...], - msg => "Message", file => "File"}) - -Sends one or more files by mail. If a mail in $sender is opened it gets closed -and a new mail is created and sent. $sender is then closed. -If some parameters are unspecified or empty, it uses -the parameters passed to the "C<$Sender=new Mail::Sender(...)>"; - -The C parameter may be a "filename", a "list, of, file, names" or a \@list_of_file_names. - -see C for info about the parameters. - -Just keep in mind that parameters like ctype, charset and encoding -will be used for the attached file, not the body of the message. -If you want to specify those parameters for the body you have to use -b_ctype, b_charset and b_encoding. Sorry. - -Returns ref to the Mail::Sender object if successfull. - -=cut - -sub MailFile { - my $self = shift; - my $msg; - local $_; - my ($file, $desc, $haddesc,$ctype,$charset,$encoding); - my @files; - if (ref $_[0] eq 'HASH') { - my $hash = $_[0]; - $msg = $hash->{'msg'}; -# delete $hash->{'msg'}; - - $file=$hash->{'file'}; -# delete $hash->{'file'}; - - $desc=$hash->{'description'}; $haddesc = 1 if defined $desc; -# delete $hash->{'description'}; - - $ctype=$hash->{'ctype'}; -# delete $hash->{'ctype'}; - - $charset=$hash->{'charset'}; -# delete $hash->{'charset'}; - - $encoding=$hash->{'encoding'}; -# delete $hash->{'encoding'}; - - } else { - $desc=pop if ($#_ >=2); $haddesc = 1 if defined $desc; - $file = pop; - $msg = pop; - } - return $self->Error(NOMSG) unless $msg; - return $self->Error(NOFILE) unless $file; - - if (ref $file eq 'ARRAY') { - @files=@$file; - } elsif ($file =~ /,/) { - @files=split / *, */,$file; - } else { - @files = ($file); - } - foreach $file (@files) { - return $self->Error(FILENOTFOUND($file)) unless ($file =~ /^&/ or -e $file); - } - - ref $self->OpenMultipart(@_) - and - ref $self->Body( - $self->{'b_charset'}||$self->{'charset'}, - $self->{'b_encoding'}, - $self->{'b_ctype'} - ) - and - $self->SendEnc($msg) - or return $self->{'error'}; - - $Mail::Sender::Error = ''; - foreach $file (@files) { - my $cnt; - my $filename = basename $file; - my $ctype = $ctype || GuessCType $filename, $file; - my $encoding = $encoding || ($ctype =~ m#^text/#i ? 'Quoted-printable' : 'Base64'); - - $desc = $filename unless (defined $haddesc); - - $self->Part({encoding => $encoding, - disposition => (defined $self->{'disposition'} ? $self->{'disposition'} : "attachment; filename=\"$filename\""), - ctype => "$ctype; name=\"$filename\"" . (defined $charset ? "; charset=$charset" : ''), - description => $desc}); - - my $code = $self->{'code'}; - - my $FH = new FileHandle; - open $FH, "<", $file - or return $self->Error(FILECANTREAD($file)); - binmode $FH unless $ctype =~ m#^text/#i and $encoding =~ /Quoted[_\-]print|Base64/i; - my $s; - $s = $self->{'socket'}; - my $mychunksize = $chunksize; - $mychunksize = $chunksize64 if defined $self->{'chunk_size'}; - while (read $FH, $cnt, $mychunksize) { - $cnt = &$code($cnt); - $cnt =~ s/^\.\././ unless $self->{'_had_newline'}; - print $s $cnt; - $self->{'_had_newline'} = ($cnt =~ /[\n\r]$/); - } - close $FH; - } - - if ($Mail::Sender::Error eq '') { - undef $Mail::Sender::Error; - } else { - chomp $Mail::Sender::Error; - } - return $self->Close; -} - - - -=head2 Send - - Send(@strings) - -Prints the strings to the socket. Doesn't add any end-of-line characters. -Doesn't encode the data! You should use C<\r\n> as the end-of-line! - -UNLESS YOU ARE ABSOLUTELY SURE YOU KNOW WHAT YOU ARE DOING -YOU SHOULD USE SendEnc() INSTEAD! - -Returns the object if successfull. - -=cut - -sub Send { - my $self = shift; - my $s; - $s = $self->{'socket'}; - print $s @_; - return $self; -} - -=head2 SendLine - - SendLine(@strings) - -Prints the strings to the socket. Adds the end-of-line character at the end. -Doesn't encode the data! You should use C<\r\n> as the end-of-line! - -UNLESS YOU ARE ABSOLUTELY SURE YOU KNOW WHAT YOU ARE DOING -YOU SHOULD USE SendLineEnc() INSTEAD! - -Returns the object if successfull. - -=cut - -sub SendLine { - my $self = shift; - my $s = $self->{'socket'}; - print $s (@_,"\x0D\x0A"); - return $self; -} - -=head2 print - -Alias to SendEnc(). - -Keep in mind that you can't write : - - print $sender "..."; - -you have to use - - $sender->print("..."); - -If you want to be able to print into the message as if it was a normal file handle take a look at C() - -=head2 SendEnc - - SendEnc(@strings) - -Prints the strings to the socket. Doesn't add any end-of-line characters. - -Encodes the text using the selected encoding (none/Base64/Quoted-printable) - -Returns the object if successfull. - -=cut - -sub SendEnc { - my $self = shift; - local $_; - my $code = $self->{'code'}; - $self->{'code'}= $code = \&enc_plain - unless defined $code; - my $s; - $s = $self->{'socket'} - or return $self->Error(NOTCONNECTED); - if (defined $self->{'chunk_size'}) { - my $str; - my $chunk = $self->{'chunk_size'}; - if (defined $self->{'_buffer'}) { - $str=(join '',($self->{'_buffer'},@_)); - } else { - $str=join '',@_; - } - my ($len,$blen); - $len = length $str; - if (($blen=($len % $chunk)) >0) { - $self->{'_buffer'} = substr($str,($len-$blen)); - print $s (&$code(substr( $str,0,$len-$blen))); - } else { - delete $self->{'_buffer'}; - print $s (&$code($str)); - } - } else { - my $encoded = &$code(join('',@_)); - $encoded =~ s/^\.\././ unless $self->{'_had_newline'}; - print $s $encoded; - $self->{'_had_newline'} = ($_[-1] =~ /[\n\r]$/); - } - return $self; -} - -sub print;*print = \&SendEnc; - -=head2 SendLineEnc - - SendLineEnc(@strings) - -Prints the strings to the socket and adds the end-of-line character at the end. -Encodes the text using the selected encoding (none/Base64/Quoted-printable). - -Do NOT mix up /Send(Line)?(Ex)?/ and /Send(Line)?Enc/! SendEnc does some buffering -necessary for correct Base64 encoding, and /Send(Ex)?/ is not aware of that! - -Usage of /Send(Line)?(Ex)?/ in non xBIT parts not recommended. -Using C may work, but more likely it will not! -In particular if you use several such to create one part, -the data is very likely to get crippled. - -Returns the object if successfull. - -=cut - -sub SendLineEnc { - push @_, "\r\n"; - goto &SendEnc; -} - -=head2 SendEx - - SendEx(@strings) - -Prints the strings to the socket. Doesn't add any end-of-line characters. -Changes all end-of-lines to C<\r\n>. Doesn't encode the data! - -UNLESS YOU ARE ABSOLUTELY SURE YOU KNOW WHAT YOU ARE DOING -YOU SHOULD USE SendEnc() INSTEAD! - -Returns the object if successfull. - -=cut - -sub SendEx { - my $self = shift; - my $s; - $s = $self->{'socket'} - or return $self->Error(NOTCONNECTED); - my $str;my @data = @_; - foreach $str (@data) { - $str =~ s/(?:\x0D\x0A?|\x0A)/\x0D\x0A/sg; - $str =~ s/^\./../mg; - } - print $s @data; - return $self; -} - -=head2 SendLineEx - - SendLineEx(@strings) - -Prints the strings to the socket. Adds an end-of-line character at the end. -Changes all end-of-lines to C<\r\n>. Doesn't encode the data! - -UNLESS YOU ARE ABSOLUTELY SURE YOU KNOW WHAT YOU ARE DOING -YOU SHOULD USE SendEnc() INSTEAD! - -Returns the object if successfull. - -=cut - -sub SendLineEx { - push @_, "\r\n"; - goto &SendEx; -} - - -=head2 Part - - Part( I, I, I, I [, I [, I]]); - Part( {[description => "desc"], [ctype => "content-type"], [encoding => "..."], - [disposition => "..."], [content_id => "..."], [msg => ...]}); - -Prints a part header for the multipart message and (if specified) the contents. -The undefined or empty variables are ignored. - -=over 2 - -=item description - -The title for this part. - -=item ctype - -the content type (MIME type) of this part. May contain some other -parameters, such as B or B. - -Defaults to "application/octet-stream". - -Since 0.8.00 you may use even "multipart/..." types. Such a multipart part should be -closed by a call to $sender->EndPart($ctype). - - ... - $sender->Part({ctype => "multipart/related", ...}); - $sender->Part({ctype => 'text/html', ...}); - $sender->Attach({file => 'some_image.gif', content_id => 'foo', ...}); - $sender->EndPart("multipart/related"); - ... - -Please see the examples below. - -=item encoding - -the encoding used for this part of message. Eg. Base64, Uuencode, 7BIT -... - -Defaults to "7BIT". - -=item disposition - -This parts disposition. Eg: 'attachment; filename="send.pl"'. - -Defaults to "attachment". If you specify "none" or "", the -Content-disposition: line will not be included in the headers. - -=item content_id - -The content id of the part, used in multipart/related. -If not specified, the header is not included. - -=item msg - -The content of the part. You do not have to specify the content here, you may use SendEnc() -to add content to the part. - -=item charset - -The charset of the part. - -=back - -Returns the Mail::Sender object if successfull, negative error code if not. - -=cut - -sub Part { - my $self = shift; - local $_; - if (! $self->{'multipart'}) { return $self->Error(NOTMULTIPART("\$sender->Part()")); } - $self->EndPart(); - - my ($description, $ctype, $encoding, $disposition, $content_id, $msg, $charset); - if (ref $_[0] eq 'HASH') { - my $hash=$_[0]; - $description=$hash->{'description'}; - $ctype=$hash->{'ctype'}; - $encoding=$hash->{'encoding'}; - $disposition=$hash->{'disposition'}; - $content_id = $hash->{'content_id'}; - $msg = $hash->{'msg'}; - $charset = $hash->{'charset'}; - } else { - ($description, $ctype, $encoding, $disposition, $content_id, $msg) = @_; - } - - $ctype = "application/octet-stream" unless defined $ctype; - $disposition = "attachment" unless defined $disposition; - $encoding="7BIT" unless defined $encoding; - $self->{'encoding'} = $encoding; - if (defined $charset and $charset and $ctype !~ /charset=/i) { - $ctype .= qq{; charset="$charset"} - } - - my $s; - $s = $self->{'socket'} - or return $self->Error(NOTCONNECTED); - - undef $self->{'chunk_size'}; - if ($encoding =~ /Base64/i) { - $self->{'code'}=\&enc_base64; - $self->{'chunk_size'} = $enc_base64_chunk; - } elsif ($encoding =~ /Quoted[_\-]print/i) { - $self->{'code'}=\&enc_qp; - } else { - $self->{'code'}=\&enc_plain; - } - - $self->{'socket'}->start_logging() if ($self->{'debug'} and $self->{'debug_level'} == 3); - - if ($ctype =~ m{^multipart/}i) { - $self->{'_part'}+=2; - print $s "Content-Type: $ctype; boundary=\"Part-$self->{'boundary'}_$self->{'_part'}\"\r\n\r\n"; - } else { - $self->{'_part'}++; - print $s "Content-type: $ctype\r\n"; - if ($description) {print $s "Content-description: $description\r\n";} - print $s "Content-transfer-encoding: $encoding\r\n"; - print $s "Content-disposition: $disposition\r\n" unless $disposition eq '' or uc($disposition) eq 'NONE'; - print $s "Content-ID: <$content_id>\r\n" if (defined $content_id); - print $s "\r\n"; - - $self->{'socket'}->stop_logging("... data skipped ...") if ($self->{'debug'} and $self->{'debug_level'} == 3); - $self->SendEnc($msg) if defined $msg; - } - - #$self->{'_had_newline'} = 1; - return $self; -} - - -=head2 Body - - Body([charset [, encoding [, content-type]]]); - Body({charset => '...', encoding => '...', ctype => '...', msg => '...'); - -Sends the head of the multipart message body. You can specify the -charset and the encoding. Default is "US-ASCII","7BIT",'text/plain'. - -If you pass undef or zero as the parameter, this function uses the default -value: - - Body(0,0,'text/html'); - -Returns the Mail::Sender object if successfull, negative error code if not. -You should NOT use this method in single part messages, that is, it works after OpenMultipart(), -but has no meaning after Open()! - -=cut - -sub Body { - my $self = shift; - if (! $self->{'multipart'}) { - # ->Body() has no meanin in singlepart messages - if (@_) { - # they called it with some parameters? Too late for them, let's scream. - return $self->Error(NOTMULTIPART("\$sender->Body()")); - } else { - # $sender->Body() ... OK, let's ignore it. - return $self; - } - } - my $hash; - $hash = shift() if (ref $_[0] eq 'HASH'); - my $charset = shift || $hash->{'charset'} || 'US-ASCII'; - my $encoding = shift || $hash->{'encoding'} || $self->{'encoding'} || '7BIT'; - my $ctype = shift || $hash->{'ctype'} || $self->{'ctype'} || 'text/plain'; - - $ctype .= qq{; charset="$charset"} - unless $ctype =~ /charset=/i; - - $self->{'encoding'} = $encoding; - $self->{'ctype'} = $ctype; - - $self->Part("Mail message body", $ctype, - $encoding, 'inline', undef, $hash->{'msg'}); - return $self; -} - -=head2 SendFile - -Alias to Attach() - -=head2 Attach - - Attach( I, I, I, I, I); - Attach( { [description => "desc"] , [ctype => "ctype"], [encoding => "encoding"], - [disposition => "disposition"], file => "file"}); - - Sends a file as a separate part of the mail message. Only in multipart mode. - -=over 2 - -=item description - -The title for this part. - -=item ctype - -the content type (MIME type) of this part. May contain some other -parameters, such as B or B. - -Defaults to "application/octet-stream". - -=item encoding - -the encoding used for this part of message. Eg. Base64, Uuencode, 7BIT -... - -Defaults to "Base64". - -=item disposition - -This parts disposition. Eg: 'attachment; filename="send.pl"'. If you use -'attachment; filename=*' the * will be replaced by the respective names -of the sent files. - -Defaults to "attachment; filename=*". If you do not want to include this header use -"" as the value. - -=item file - -The name of the file to send or a 'list, of, names' or a -['reference','to','a','list','of','filenames']. Each file will be sent as -a separate part. - -Please keep in mind that if you pass a string as this parameter the module -will split it on commas! If your filenames may contain commas and you -want to be sure they are sent correctly you have to use the reference to array -format: - - file => [ $filename], - -=item content_id - -The content id of the message part. Used in multipart/related. - - Special values: - "*" => the name of the file - "#" => autoincremented number (starting from 0) - -=back - -Returns the Mail::Sender object if successfull, negative error code if not. - -=cut - -sub SendFile { - my $self = shift; - local $_; - if (! $self->{'multipart'}) { return $self->Error(NOTMULTIPART("\$sender->SendFile()")); } - if (! $self->{'socket'}) { return $self->Error(NOTCONNECTED); } - - my ($description, $ctype, $encoding, $disposition, $file, $content_id, @files); - if (ref $_[0] eq 'HASH') { - my $hash=$_[0]; - $description=$hash->{'description'}; - $ctype=$hash->{'ctype'}; - $encoding=$hash->{'encoding'}; - $disposition=$hash->{'disposition'}; - $file=$hash->{'file'}; - $content_id=$hash->{'content_id'}; - } else { - ($description, $ctype, $encoding, $disposition, $file, $content_id) = @_; - } - return ($self->{'error'}=NOFILE) unless $file; - - if (ref $file eq 'ARRAY') { - @files=@$file; - } elsif ($file =~ /,/) { - @files=split / *, */,$file; - } else { - @files = ($file); - } - foreach $file (@files) { - return $self->Error(FILENOTFOUND($file)) unless ($file =~ /^&/ or -e $file); - } - - $disposition = "attachment; filename=*" unless defined $disposition; - $encoding='Base64' unless $encoding; - - my $s=$self->{'socket'}; - - if ($self->{'_buffer'}) { - my $code = $self->{'code'}; - print $s (&$code($self->{'_buffer'})); - delete $self->{'_buffer'}; - } - - my $code; - if ($encoding =~ /Base64/i) { - $code=\&enc_base64; - } elsif ($encoding =~ /Quoted[_\-]print/i) { - $code=\&enc_qp; - } else { - $code=\&enc_plain; - } - $self->{'code'}=$code; - - foreach $file (@files) { - $self->EndPart();$self->{'_part'}++; - $self->{'encoding'} = $encoding; - my $cnt=''; - my $name = basename $file; - my $fctype = $ctype ? $ctype : GuessCType $name, $file; - $self->{'ctype'} = $fctype; - - $self->{'socket'}->start_logging() if ($self->{'debug'} and $self->{'debug_level'} == 3); - - if ($fctype =~ /;\s*name=/) { - print $s ("Content-type: $fctype\r\n"); - } else { - print $s ("Content-type: $fctype; name=\"$name\"\r\n"); - } - - if ($description) {print $s ("Content-description: $description\r\n");} - print $s ("Content-transfer-encoding: $encoding\r\n"); - - if ($disposition =~ /^(.*)filename=\*(.*)$/i) { - print $s ("Content-disposition: ${1}filename=\"$name\"$2\r\n"); - } elsif ($disposition and uc($disposition) ne 'NONE') { - print $s ("Content-disposition: $disposition\r\n"); - } - - if ($content_id) { - if ($content_id eq '*') { - print $s ("Content-ID: <$name>\r\n"); - } elsif ($content_id eq '#') { - print $s ("Content-ID: {'idcounter'}++.">\r\n"); - } else { - print $s ("Content-ID: <$content_id>\r\n"); - } - } - print $s "\r\n"; - - $self->{'socket'}->stop_logging("... data skipped ...") if ($self->{'debug'} and $self->{'debug_level'} == 3); - - my $FH = new FileHandle; - open $FH, "<", $file - or return $self->Error(FILECANTREAD($file)); - binmode $FH unless $fctype =~ m#^text/#i and $encoding =~ /Quoted[_\-]print|Base64/i; - - my $mychunksize = $chunksize; - $mychunksize = $chunksize64 if lc($encoding) eq "base64"; - my $s; - $s = $self->{'socket'} - or return $self->Error(NOTCONNECTED); - while (read $FH, $cnt, $mychunksize) { - print $s (&$code($cnt)); - } - close $FH; - } - - return $self; -} - -sub Attach; *Attach = \&SendFile; - -=head2 EndPart - - $sender->EndPart($ctype); - -Closes a multipart part. - -If the $ctype is not present or evaluates to false, only the current SIMPLE part is closed! -Don't do that unless you are really sure you know what you are doing. - -It's best to always pass to the ->EndPart() the content type of the corresponding ->Part(). - -=cut - -sub EndPart { - my $self = shift; - return unless $self->{'_part'}; - my $end = shift(); - my $s; - my $LN = "\x0D\x0A"; - $s = $self->{'socket'} - or return $self->Error(NOTCONNECTED); - # flush the buffer (if it contains anything) - if ($self->{'_buffer'}) { # used only for base64 - my $code = $self->{'code'}; - if (defined $code) { - print $s (&$code($self->{'_buffer'})); - } else { - print $s ($self->{'_buffer'}); - } - delete $self->{'_buffer'}; - } - if ($self->{'_had_newline'}) { - $LN = ''; - } else { - print $s "=" if !$self->{'bypass_outlook_bug'} and $self->{'encoding'} =~ /Quoted[_\-]print/i; # make sure we do not add a newline - } - - $self->{'socket'}->start_logging() if ($self->{'debug'} and $self->{'debug_level'} == 3); - - if ($self->{'_part'}>1) { # end of a subpart - print $s "$LN--Part-$self->{'boundary'}_$self->{'_part'}", - ($end ? "--" : ()), - "\r\n"; - } else { - print $s "$LN--$self->{'boundary'}", - ($end ? "--" : ()), - "\r\n"; - } - - $self->{'_part'}--; - $self->{'code'}=\&enc_plain; - $self->{'encoding'} = ''; - return $self; -} - -=head2 Close - - $sender->Close; - $sender->Close(1); - -Close and send the email message. If you pass a true value to the method the connection will be closed even -if the "keepconnection" was specified. You should only keep the connection open if you plan to send another -message immediately. And you should not keep it open for hundreds of emails even if you do send them all in a row. - -This method should be called automatically when destructing the object, but you should not rely on it. If you want to be sure -your message WAS processed by the SMTP server you SHOULD call Close() explicitely. - -Returns the Mail::Sender object if successfull, negative error code if not, zero if $sender was not connected at all. -The zero usualy means that the Open/OpenMultipart failed and you did not test its return value. - -=cut - -sub Close { - my $self = shift; - local $_; - my $s = $self->{'socket'}; - return 0 unless $s; - - if ($self->{'_data'}) { - # flush the buffer (if it contains anything) - if ($self->{'_buffer'}) { - my $code = $self->{'code'}; - if (defined $code) { - print $s (&$code($self->{'_buffer'})); - } else { - print $s ($self->{'_buffer'}); - } - delete $self->{'_buffer'}; - } - - if ($self->{'_part'}) { - while ($self->{'_part'}) { - $self->EndPart(1); - } - } - - $self->{'socket'}->start_logging() if ($self->{'debug'}); - print $s "\r\n.\r\n" ; - $self->{'_data'} = 0; - $_ = get_response($s); if (/^[45]\d* (.*)$/) { return $self->Error(TRANSFAILED($1)); } - $self->{message_response} = $_; - } - - delete $self->{'encoding'}; - delete $self->{'ctype'}; - - if ($_[0] or !$self->{'keepconnection'}) { - $_ = send_cmd $s, "QUIT"; - if (!/^[123]/) { return $self->Error(COMMERROR($_)); } - close $s; - delete $self->{'socket'}; - delete $self->{'debug'}; - } - return $self; -} - -=head2 Cancel - - $sender->Cancel; - -Cancel an opened message. - -SendFile and other methods may set $sender->{'error'}. -In that case "undef $sender" calls C<$sender->>Cancel not C<$sender->>Close!!! - -Returns the Mail::Sender object if successfull, negative error code if not. - -=cut - -sub Cancel { - my $self = shift; - my $s; - $s = $self->{'socket'} - or return $self->Error(NOTCONNECTED); - close $s; - delete $self->{'socket'}; - delete $self->{'error'}; - return $self; -} - -sub DESTROY { - return if ref($_[0]) ne 'Mail::Sender'; - my $self = shift; - if (defined $self->{'socket'}) { - delete $self->{'keepconnection'}; - $self->Close; - } -} - -sub MessageID { - my $from = shift; - my ($sec,$min,$hour,$mday,$mon,$year) - = gmtime(time); - $mon++;$year+=1900; - - return sprintf "<%04d%02d%02d_%02d%02d%02d_%06d.%s>", - $year,$mon,$mday,$hour,$min,$sec,rand(100000), - $from; -} - -=head2 QueryAuthProtocols - - @protocols = $sender->QueryAuthProtocols(); - @protocols = $sender->QueryAuthProtocols( $smtpserver); - - -Queryies the server (specified either in the default options for Mail::Sender, -the "new Mail::Sender" command or as a parameter to this method for -the authentication protocols it supports. - -=cut - -sub QueryAuthProtocols { - my $self = shift; - local $_; - if (!defined $self) { - croak "Mail::Sender::QueryAuthProtocols() called without any parameter!"; - } elsif (ref $self) { # $sender->QueryAuthProtocols() or $sender->QueryAuthProtocols('the.server.com) - if ($self->{'socket'}) { # the user did not Close() or Cancel() the previous mail - die "You forgot to close the mail before calling QueryAuthProtocols!\n" - } - if (@_) { - $self->{'smtp'} = shift(); - $self->{'smtp'} =~ s/^\s+//g; # remove spaces around $smtp - $self->{'smtp'} =~ s/\s+$//g; - $self->{'smtpaddr'} = inet_aton($self->{'smtp'}); - if (!defined($self->{'smtpaddr'})) { return $self->Error(HOSTNOTFOUND($self->{'smtp'})); } - $self->{'smtpaddr'} = $1 if ($self->{'smtpaddr'} =~ /(.*)/s); # Untaint - } - } elsif ($self =~ /::/) { # Mail::Sender->QueryAuthProtocols('the.server.com') - croak "Mail::Sender->QueryAuthProtocols() called without any parameter!" - if ! @_; - $self = new Mail::Sender {smtp => $_[0]}; - return unless ref $self; - } else { # Mail::Sender::QueryAuthProtocols('the.server.com') - $self = new Mail::Sender {smtp => $self}; - return unless ref $self; - } - - return $self->Error(NOSERVER) unless defined $self->{'smtp'}; - - my $s = IO::Socket::INET->new( - PeerHost => $self->{'smtp'}, - PeerPort => $self->{'port'}, - Proto => "tcp", - Timeout => $self->{'timeout'} || 120, - ) or return $self->Error(CONNFAILED); - - binmode($s) - unless ($] >= 5.008); - - $s->autoflush(1); - - $_ = get_response($s); if (not $_ or !/^[123]/) { return $self->Error(SERVNOTAVAIL($_)); } - $self->{'server'} = substr $_, 4; - - { my $res = $self->say_helo($s); - return $res if $res; - } - - $_ = send_cmd $s, "QUIT"; - close $s; - delete $self->{'socket'}; - - if (wantarray) { - return keys %{$self->{'auth_protocols'}}; - } else { - my $key = each %{$self->{'auth_protocols'}}; - return $key; - } -} - -sub printAuthProtocols { - print "$_[1] supports: ",join(", ", Mail::Sender->QueryAuthProtocols($_[1] || 'localhost')),"\n"; -} - -sub TestServer { - my $self = shift; - local $_; - if (!defined $self) { - croak "Mail::Sender::TestServer() called without any parameter!"; - } elsif (ref $self) { # $sender->TestServer() or $sender->TestServer('the.server.com) - if ($self->{'socket'}) { # the user did not Close() or Cancel() the previous mail - die "You forgot to close the mail before calling TestServer!\n" - } - if (@_) { - $self->{'smtp'} = shift(); - $self->{'smtp'} =~ s/^\s+//g; # remove spaces around $smtp - $self->{'smtp'} =~ s/\s+$//g; - $self->{'smtpaddr'} = inet_aton($self->{'smtp'}); - if (!defined($self->{'smtpaddr'})) { return $self->Error(HOSTNOTFOUND($self->{'smtp'})); } - $self->{'smtpaddr'} = $1 if ($self->{'smtpaddr'} =~ /(.*)/s); # Untaint - } - $self->{'on_errors'} = 'die'; - } elsif ($self =~ /::/) { # Mail::Sender->TestServer('the.server.com') - croak "Mail::Sender->TestServer() called without any parameter!" - if ! @_; - $self = new Mail::Sender {smtp => $_[0], on_errors => 'die'}; - return unless ref $self; - } else { # Mail::Sender::QueryAuthProtocols('the.server.com') - $self = new Mail::Sender {smtp => $self, on_errors => 'die'}; - return unless ref $self; - } - - return $self->Error(NOSERVER) unless defined $self->{'smtp'}; -# if (!defined($self->{'smtpaddr'})) { return $self->Error(HOSTNOTFOUND($self->{'smtp'})); } - - if (exists $self->{'on_errors'} and (!defined($self->{'on_errors'}) or $self->{'on_errors'} eq 'undef')) { - return $self->Connect() and $self->Close() and 1; - } elsif (exists $self->{'on_errors'} and $self->{'on_errors'} eq 'die') { - $self->Connect(); - $self->Close(); - return 1; - } else { - my $res = $self->Connect(); - return $res unless ref $res; - $res = $self->Close(); - return $res unless ref $res; - return $self; - } -} - -#====== Debuging bazmecks - -$debug_code = <<'*END*'; -package Mail::Sender::DBIO; -use IO::Handle; -use Tie::Handle; -@Mail::Sender::DBIO::ISA = qw(Tie::Handle); - -sub SOCKET () {0} -sub LOG () {1} -sub ENDLINE () {2} -sub CLOSELOG () {3} -sub OFF () {4} - -sub TIEHANDLE { - my ($pkg,$socket,$debughandle, $mayCloseLog) = @_; - return bless [$socket,$debughandle,1, $mayCloseLog,0], $pkg; -} - -sub PRINT { - my $self = shift; - my $text = join(($\ || ''), @_); - $self->[SOCKET]->print($text); - return if $self->[OFF]; - $text =~ s/\x0D\x0A(?=.)/\x0D\x0A<< /g; - $text = "<< ".$text if $self->[ENDLINE]; - $self->[ENDLINE] = ($text =~ /\x0D\x0A$/); - $self->[LOG]->print($text); -} - -sub READLINE { - my $self = shift(); - my $socket = $self->[SOCKET]; - my $line = <$socket>; - $self->[LOG]->print(">> $line") if defined $line and !$self->[OFF]; - return $line; -} - -sub CLOSE { - my $self = shift(); - $self->[SOCKET]->close(); - $self->[LOG]->close() if $self->[CLOSELOG]; - return $self->[SOCKET]; -} - -sub opened { - our $SOCKET; - local *SOCKET = $_[SOCKET]; - $SOCKET->opened(); -} - -use Data::Dumper; -sub stop_logging { - my $self = tied(${$_[0]}); - -#print "stop_logging( ".$self." )\n"; - - return if $self->[OFF]; - $self->[OFF] = 1; - - my $text = join(($\ || ''), $_[1]) - or return; - $text .= "\x0D\x0A"; - $text =~ s/\x0D\x0A(?=.)/\x0D\x0A<< /g; - $text = "<< ".$text if $self->[ENDLINE]; - $self->[ENDLINE] = ($text =~ /\x0D\x0A$/); - $self->[LOG]->print($text); -} - -sub start_logging { - my $self = tied(${$_[0]}); - $self->[OFF] = 0; -} - -*END* - -my $pseudo_handle_code = <<'*END*'; -package Mail::Sender::IO; -use IO::Handle; -use Tie::Handle; -@Mail::Sender::IO::ISA = qw(Tie::Handle); - -sub TIEHANDLE { - my ($pkg,$sender) = @_; - return bless [$sender, $sender->{'_part'}], $pkg; -} - -sub PRINT { - my $self = shift; - $self->[0]->SendEnc(@_); -} - -sub PRINTF { - my $self = shift; - my $format = shift; - $self->[0]->SendEnc( sprintf $format, @_); -} - -sub CLOSE { - my $self = shift(); - if ($self->[1]) { - $self->[1]->EndPart(); - } else { - $self->[0]->Close(); - } -} -*END* - -=head2 GetHandle - -Returns a "filehandle" to which you can print the message or file to attach or whatever. -The data you print to this handle will be encoded as necessary. Closing this handle closes -either the message (for single part messages) or the part. - - $sender->Open({...}); - my $handle = $sender->GetHandle(); - print $handle "Hello world.\n" - my ($mday,$mon,$year) = (localtime())[3,4,5]; - printf $handle "Today is %04d/%02d/%02d.", $year+1900, $mon+1, $mday; - close $handle; - -P.S.: There is a big difference between the handle stored in $sender->{'socket'} and the handle -returned by this function ! If you print something to $sender->{'socket'} it will be sent to the server -without any modifications, encoding, escaping, ... -You should NOT touch the $sender->{'socket'} unless you really really know what you are doing. - -=cut - -package Mail::Sender; -sub GetHandle { - my $self = shift(); - unless (defined @Mail::Sender::IO::ISA) { - eval "use Symbol;"; - eval $pseudo_handle_code; - } - my $handle = gensym(); - tie *$handle, 'Mail::Sender::IO', $self; - return $handle; -} - -=head1 FUNCTIONS - -=head2 GuessCType - - $ctype = GuessCType $filename, $filepath; - -Guesses the content type based on the filename or the file contents. -This function is used when you attach a file and do not specify the content type. -It is not exported by default! - -The builtin version uses the filename extension to guess the type. -Currently there are only a few extensions defined, you may add other extensions this way: - - $Mail::Sender::CTypes{'EXT'} = 'content/type'; - ... - -The extension has to be in UPPERCASE and will be matched case sensitively. - -The package now includes two addins improving the guesswork. If you "use" one of them in your script, -it replaces the builtin GuessCType() subroutine with a better one: - - Mail::Sender::CType::Win32 - Win32 only, the content type is read from the registry - Mail::Sender::CType::Ext - any OS, a longer list of extensions from A. Guillaume - -=head2 ResetGMTdiff - - ResetGMTdiff() - -The module computes the local vs. GMT time difference to include in the timestamps -added into the message headers. As the time difference may change due to summer -savings time changes you may want to reset the time difference ocassionaly -in long running programs. - -=head1 CONFIG - -If you create a file named Sender.config in the same directory where -Sender.pm resides, this file will be "require"d as soon as you "use -Mail::Sender" in your script. Of course the Sender.config MUST "return a -true value", that is it has to be successfully compiled and the last -statement must return a true value. You may use this to forbide the use -of Mail::Sender to some users. - -You may define the default settings for new Mail::Sender objects and do -a few more things. - -The default options are stored in hash %Mail::Sender::default. You may -use all the options you'd use in C, C, C, -C or C. - - Eg. - %default = ( - smtp => 'mail.yourhost.cz', - from => getlogin.'yourhost.cz', - client => getlogin.'.yourhost.cz' - ); - # of course you will use your own mail server here ! - -The other options you may set here (or later of course) are -$Mail::Sender::SITE_HEADERS, $Mail::Sender::NO_X_MAILER and -$Mail::Sender::NO_DATE. (These are plain old scalar variables, there is no -function or method for modifying them. Just set them to anything you need.) - -The $Mail::Sender::SITE_HEADERS may contain headers that will be added -to each mail message sent by this script, the $Mail::Sender::NO_X_MAILER -disables the header item specifying that the message was sent by -Mail::Sender and $Mail::Sender::NO_DATE turns off the Date: header generation. - -!!! $Mail::Sender::SITE_HEADERS may NEVER end with \r\n !!! - -If you want to set the $Mail::Sender::SITE_HEADERS for every script sent -from your server without your users being able to change it you may use -this hack: - - $loginname = something_that_identifies_the_user(); - *Mail::Sender::SITE_HEADERS = \"X-Sender: $loginname via $0"; - $Mail::Sender::NO_X_MAILER = 1; - -You may even "install" your custom function that will be evaluated for -each message just before contacting the server. You may change all the -options from within as well as stop sending the message. - -All you have to do is to create a function named SiteHook in -Mail::Sender package. This function will get the Mail::Sender object as -its first argument. If it returns a TRUE value the message is sent, -if it returns FALSE the sending is canceled and the user gets -"Site specific error" error message. - -If you want to give some better error message you may do it like this : - - sub SiteHook { - my $self = shift; - if (whatever($self)) { - $self->Error( SITEERROR); - $Mail::Sender::Error = "I don't like this mail"; - return 0 - } else { - return 1; - } - } - - -This example will ensure the from address is the users real address : - - sub SiteHook { - my $self = shift; - $self->{'fromaddr'} = getlogin.'@yoursite.com'; - $self->{'from'} = getlogin.'@yoursite.com'; - 1; - } - -Please note that at this stage the from address is in two different -object properties. - -$self->{'from'} is the address as it will appear in the mail, that is -it may include the full name of the user or any other comment -( "Jan Krynicky " for example), while the -$self->{'fromaddr'} is realy just the email address per se and it will -be used in conversation with the SMTP server. It must be without -comments ("jenda@krynicky.cz" for example)! - - -Without write access to .../lib/Mail/Sender.pm or -.../lib/Mail/Sender.config your users will then be unable to get rid of -this header. Well ... everything is doable, if they are cheeky enough ... :-( - -So if you take care of some site with virtual servers for several -clients and implement some policy via SiteHook() or -$Mail::Sender::SITE_HEADERS search the clients' scripts for "SiteHook" -and "SITE_HEADERS" from time to time. To see who's cheating. - -=head1 AUTHENTICATION - -If you get a "Local user "xxx@yyy.com" unknown on host "zzz"" message it usualy means that -your mail server is set up to forbid mail relay. That is it only accepts messages to or from a local user. -If you need to be able to send a message with both the sender's and recipient's address remote, you -need to somehow authenticate to the server. You may need the help of the mail server's administrator -to find out what username and password and/or what authentication protocol are you supposed to use. - -There are many authentication protocols defined for ESTMP, Mail::Sender natively supports -only PLAIN, LOGIN, CRAM-MD5 and NTLM (please see the docs for C). - -If you want to know what protocols are supported by your server you may get the list by this: - - /tmp# perl -MMail::Sender -e 'Mail::Sender->printAuthProtocols("the.server.com")' - or - c:\> perl -MMail::Sender -e "Mail::Sender->printAuthProtocols('the.server.com')" - - -There is one more way to authenticate. Some servers want you to login by POP3 before you -can send a message. You have to use Net::POP3 or Mail::POP3Client to do this. - -=head2 Other protocols - -It is possible to add new authentication protocols to Mail::Sender. All you have to do is -to define a function Mail::Sender::Auth::PROTOCOL_NAME that will implement -the login. The function gets one parameter ... the Mail::Sender object. -It can access these properties: - - $obj->{'socket'} : the socket to print to and read from - you may use the send_cmd() function to send a request - and read a response from the server - $obj->{'authid'} : the username specified in the new Mail::Sender, - Open or OpenMultipart call - $obj->{'authpwd'} : the password - $obj->{auth...} : all unknown parameters passed to the constructor or the mail - opening/creation methods are preserved in the object. If the protocol requires - any other options, please use names starting with "auth". Eg. "authdomain", ... - $obj->{'error'} : this should be set to a negative error number. Please use numbers - below -1000 for custom errors. - $obj->{'error_msg'} : this should be set to the error message - - If the login fails you should - 1) Set $Mail::Sender::Error to the error message - 2) Set $obj->{'error_msg'} to the error message - 2) Set $obj->{'error'} to a negative number - 3) return a negative number - If it succeeds, please return "nothing" : - return; - -Please use the protocols defined within Sender.pm as examples. - -=head1 EXAMPLES - -=head2 Object creation - - ref ($sender = new Mail::Sender { from => 'somebody@somewhere.com', - smtp => 'mail.yourISP.com', boundary => 'This-is-a-mail-boundary-435427'}) - or die "Error in mailing : $Mail::Sender::Error\n"; - -or - - my $sender = new Mail::Sender { ... }; - die "Error in mailing : $Mail::Sender::Error\n" unless ref $sender; - -or - - my $sender = new Mail::Sender { ..., on_errors => 'undef' } - or die "Error in mailing : $Mail::Sender::Error\n"; - -You may specify the options either when creating the Mail::Sender object -or later when you open a message. You may also set the default options when -installing the module (See C section). This way the admin may set -the SMTP server and even the authentication options and the users do not have -to specify it again. - -You should keep in mind that the way Mail::Sender reports failures depends on the 'on_errors'=> -option. If you set it to 'die' it throws an exception, if you set it to C or C<'undef'> it returns -undef and otherwise it returns a negative error code! - -=head2 Simple single part message - - $sender = new Mail::Sender { - smtp => 'mail.yourISP.com', - from => 'somebody@somewhere.com', - on_errors => undef, - } - or die "Can't create the Mail::Sender object: $Mail::Sender::Error\n"; - $sender->Open({ - to => 'mama@home.org, papa@work.com', - cc => 'somebody@somewhere.com', - subject => 'Sorry, I\'ll come later.' - }) - or die "Can't open the message: $sender->{'error_msg'}\n"; - $sender->SendLineEnc("I'm sorry, but thanks to the lusers, - I'll come at 10pm at best."); - $sender->SendLineEnc("\nHi, Jenda"); - $sender->Close() - or die "Failed to send the message: $sender->{'error_msg'}\n"; - -or - - eval { - $sender = new Mail::Sender { - smtp => 'mail.yourISP.com', - from => 'somebody@somewhere.com', - on_errors => 'die', - }; - $sender->Open({ - to => 'mama@home.org, papa@work.com', - cc => 'somebody@somewhere.com', - subject => 'Sorry, I\'ll come later.' - }); - $sender->SendLineEnc("I'm sorry, but thanks to the lusers, - I'll come at 10pm at best."); - $sender->SendLineEnc("\nHi, Jenda"); - $sender->Close(); - }; - if ($@) { - die "Failed to send the message: $@\n"; - } - -or - - $sender = new Mail::Sender { - smtp => 'mail.yourISP.com', - from => 'somebody@somewhere.com', - on_errors => 'code', - }; - die "Can't create the Mail::Sender object: $Mail::Sender::Error\n" - unless ref $sender; - ref $sender->Open({ - to => 'mama@home.org, papa@work.com', - cc => 'somebody@somewhere.com', - subject => 'Sorry, I\'ll come later.' - }) - or die "Can't open the message: $sender->{'error_msg'}\n"; - $sender->SendLineEnc("I'm sorry, but thanks to the lusers, - I'll come at 10pm at best."); - $sender->SendLineEnc("\nHi, Jenda"); - ref $sender->Close - or die "Failed to send the message: $sender->{'error_msg'}\n"; - -=head2 Using GetHandle() - - ref $sender->Open({to => 'friend@other.com', subject => 'Hello dear friend'}) - or die "Error: $Mail::Sender::Error\n"; - my $FH = $sender->GetHandle(); - print $FH "How are you?\n\n"; - print $FH <<'*END*'; - I've found these jokes. - - Doctor, I feel like a pack of cards. - Sit down and I'll deal with you later. - - Doctor, I keep thinking I'm a dustbin. - Don't talk rubbish. - - Hope you like'em. Jenda - *END* - - $sender->Close; - # or - # close $FH; - -or - - eval { - $sender->Open({ on_errors => 'die', - to => 'mama@home.org, papa@work.com', - cc => 'somebody@somewhere.com', - subject => 'Sorry, I\'ll come later.'}); - $sender->SendLineEnc("I'm sorry, but due to a big load of work, - I'll come at 10pm at best."); - $sender->SendLineEnc("\nHi, Jenda"); - $sender->Close; - }; - if ($@) { - print "Error sending the email: $@\n"; - } else { - print "The mail was sent.\n"; - } - -=head2 Multipart message with attachment - - $sender->OpenMultipart({to => 'Perl-Win32-Users@activeware.foo', - subject => 'Mail::Sender.pm - new module'}); - $sender->Body; - $sender->SendEnc(<<'*END*'); - Here is a new module Mail::Sender. - It provides an object based interface to sending SMTP mails. - It uses a direct socket connection, so it doesn't need any - additional program. - - Enjoy, Jenda - *END* - $sender->Attach( - {description => 'Perl module Mail::Sender.pm', - ctype => 'application/x-zip-encoded', - encoding => 'Base64', - disposition => 'attachment; filename="Sender.zip"; type="ZIP archive"', - file => 'sender.zip' - }); - $sender->Close; - -or - - $sender->OpenMultipart({to => 'Perl-Win32-Users@activeware.foo', - subject => 'Mail::Sender.pm - new version'}); - $sender->Body({ msg => <<'*END*' }); - Here is a new module Mail::Sender. - It provides an object based interface to sending SMTP mails. - It uses a direct socket connection, so it doesn't need any - additional program. - - Enjoy, Jenda - *END* - $sender->Attach( - {description => 'Perl module Mail::Sender.pm', - ctype => 'application/x-zip-encoded', - encoding => 'Base64', - disposition => 'attachment; filename="Sender.zip"; type="ZIP archive"', - file => 'sender.zip' - }); - $sender->Close; - -or (in case you have the file contents in a scalar) - - $sender->OpenMultipart({to => 'Perl-Win32-Users@activeware.foo', - subject => 'Mail::Sender.pm - new version'}); - $sender->Body({ msg => <<'*END*' }); - Here is a new module Mail::Sender. - It provides an object based interface to sending SMTP mails. - It uses a direct socket connection, so it doesn't need any - additional program. - - Enjoy, Jenda - *END* - $sender->Part( - {description => 'Perl module Mail::Sender.pm', - ctype => 'application/x-zip-encoded', - encoding => 'Base64', - disposition => 'attachment; filename="Sender.zip"; type="ZIP archive"', - msg => $sender_zip_contents, - }); - $sender->Close; - - -=head2 Using exceptions (no need to test return values after each function) - - use Mail::Sender; - eval { - (new Mail::Sender {on_errors => 'die'}) - ->OpenMultipart({smtp=> 'jenda.krynicky.cz', to => 'jenda@krynicky.cz',subject => 'Mail::Sender.pm - new version'}) - ->Body({ msg => <<'*END*' }) - Here is a new module Mail::Sender. - It provides an object based interface to sending SMTP mails. - It uses a direct socket connection, so it doesn't need any - additional program. - - Enjoy, Jenda - *END* - ->Attach({ - description => 'Perl module Mail::Sender.pm', - ctype => 'application/x-zip-encoded', - encoding => 'Base64', - disposition => 'attachment; filename="Sender.zip"; type="ZIP archive"', - file => 'W:\jenda\packages\Mail\Sender\Mail-Sender-0.7.14.3.tar.gz' - }) - ->Close(); - } or print "Error sending mail: $@\n"; - -=head2 Using MailMsg() shortcut to send simple messages - -If everything you need is to send a simple message you may use: - - if (ref ($sender->MailMsg({to =>'Jenda@Krynicky.czX', subject => 'this is a test', - msg => "Hi Johnie.\nHow are you?"}))) { - print "Mail sent OK." - } else { - die "$Mail::Sender::Error\n"; - } - -or - - if ($sender->MailMsg({ - smtp => 'mail.yourISP.com', - from => 'somebody@somewhere.com', - to =>'Jenda@Krynicky.czX', - subject => 'this is a test', - msg => "Hi Johnie.\nHow are you?" - }) < 0) { - die "$Mail::Sender::Error\n"; - } - print "Mail sent OK." - -=head2 Using MailMsg and authentication - - if ($sender->MailMsg({ - smtp => 'mail.yourISP.com', - from => 'somebody@somewhere.com', - to =>'Jenda@Krynicky.czX', - subject => 'this is a test', - msg => "Hi Johnie.\nHow are you?" - auth => 'NTLM', - authid => 'jenda', - authpwd => 'benda', - }) < 0) { - die "$Mail::Sender::Error\n"; - } - print "Mail sent OK." - -=head2 Using MailFile() shortcut to send an attachment - -If you want to attach some files: - - (ref ($sender->MailFile( - {to =>'you@address.com', subject => 'this is a test', - msg => "Hi Johnie.\nI'm sending you the pictures you wanted.", - file => 'image1.jpg,image2.jpg' - })) - and print "Mail sent OK." - ) - or die "$Mail::Sender::Error\n"; - -=head2 Sending HTML messages - -If you are sure the HTML doesn't contain any accentuated characters (with codes above 127). - - open IN, $htmlfile or die "Cannot open $htmlfile : $!\n"; - $sender->Open({ from => 'your@address.com', to => 'other@address.com', - subject => 'HTML test', - ctype => "text/html", - encoding => "7bit" - }) or die $Mail::Sender::Error,"\n"; - - while () { $sender->SendEx($_) }; - close IN; - $sender->Close(); - -Otherwise use SendEnc() instead of SendEx() and "quoted-printable" instead of "7bit". - -Another ... quicker way ... would be: - - open IN, $htmlfile or die "Cannot open $htmlfile : $!\n"; - $sender->Open({ from => 'your@address.com', to => 'other@address.com', - subject => 'HTML test', - ctype => "text/html", - encoding => "quoted-printable" - }) or die $Mail::Sender::Error,"\n"; - - while (read IN, $buff, 4096) { $sender->SendEnc($buff) }; - close IN; - $sender->Close(); - -=head2 Sending HTML messages with inline images - - if (ref $sender->OpenMultipart({ - from => 'someone@somewhere.net', to => $recipients, - subject => 'Embedded Image Test', - boundary => 'boundary-test-1', - multipart => 'related'})) { - $sender->Attach( - {description => 'html body', - ctype => 'text/html; charset=us-ascii', - encoding => '7bit', - disposition => 'NONE', - file => 'test.html' - }); - $sender->Attach({ - description => 'ed\'s gif', - ctype => 'image/gif', - encoding => 'base64', - disposition => "inline; filename=\"apache_pb.gif\";\r\nContent-ID: ", - file => 'apache_pb.gif' - }); - $sender->Close() or die "Close failed! $Mail::Sender::Error\n"; - } else { - die "Cannot send mail: $Mail::Sender::Error\n"; - } - -And in the HTML you'll have this : - ... ... -on the place where you want the inlined image. - -Please keep in mind that the image name is unimportant, it's the Content-ID what counts! - -# or using the eval{ $obj->Method()->Method()->...->Close()} trick ... - - use Mail::Sender; - eval { - (new Mail::Sender) - ->OpenMultipart({ - to => 'someone@somewhere.com', - subject => 'Embedded Image Test', - boundary => 'boundary-test-1', - type => 'multipart/related' - }) - ->Attach({ - description => 'html body', - ctype => 'text/html; charset=us-ascii', - encoding => '7bit', - disposition => 'NONE', - file => 'c:\temp\zk\HTMLTest.htm' - }) - ->Attach({ - description => 'Test gif', - ctype => 'image/gif', - encoding => 'base64', - disposition => "inline; filename=\"test.gif\";\r\nContent-ID: ", - file => 'test.gif' - }) - ->Close() - } - or die "Cannot send mail: $Mail::Sender::Error\n"; - -=head2 Sending message with plaintext and HTML alternatives - - use Mail::Sender; - - eval { - (new Mail::Sender) - ->OpenMultipart({ - to => 'someone@somewhere.com', - subject => 'Alternatives', - # debug => 'c:\temp\zkMailFlow.log', - multipart => 'mixed', - }) - ->Part({ctype => 'multipart/alternative'}) - ->Part({ ctype => 'text/plain', disposition => 'NONE', msg => <<'*END*' }) - A long - mail - message. - *END* - ->Part({ctype => 'text/html', disposition => 'NONE', msg => <<'*END*'}) -

A long

- mail - message. -

- *END* - ->EndPart("multipart/alternative") - ->Close(); - } or print "Error sending mail: $Mail::Sender::Error\n"; - -=head2 Sending message with plaintext and HTML alternatives with inline images - - use Mail::Sender; - - eval { - (new Mail::Sender) - ->OpenMultipart({ - to => 'someone@somewhere.com', - subject => 'Alternatives with images', - # debug => 'c:\temp\zkMailFlow.log', - multipart => 'related', - }) - ->Part({ctype => 'multipart/alternative'}) - ->Part({ ctype => 'text/plain', disposition => 'NONE', msg => <<'*END*' }) - A long - mail - message. - *END* - ->Part({ctype => 'text/html', disposition => 'NONE', msg => <<'*END*'}) -

A long

- mail - message. - -

- *END* - ->EndPart("multipart/alternative") - ->Attach({ - description => 'ed\'s jpg', - ctype => 'image/jpeg', - encoding => 'base64', - disposition => "inline; filename=\"0518m_b.jpg\";\r\nContent-ID: ", - file => 'E:\pix\humor\0518m_b.jpg' - }) - ->Close(); - } or print "Error sending mail: $Mail::Sender::Error\n"; - -Keep in mind please that different mail clients display messages differently. You may -need to try several ways to create messages so that they appear the way you need. -These two examples looked like I expected in Pegasus Email and MS Outlook. - -If this doesn't work with your mail client, please let me know and we might find a way. - - -=head2 Sending a file that was just uploaded from an HTML form - - use CGI; - use Mail::Sender; - - $query = new CGI; - - # uploading the file... - $filename = $query->param('mailformFile'); - if ($filename ne ""){ - $tmp_file = $query->tmpFileName($filename); - } - - $sender = new Mail::Sender {from => 'script@krynicky.cz',smtp => 'mail.krynicky.czX'}; - $sender->OpenMultipart({to=> 'jenda@krynicky.czX',subject=> 'test CGI attach'}); - $sender->Body(); - $sender->Send(<<"*END*"); - This is just a test of mail with an uploaded file. - - Jenda - *END* - $sender->Attach({ - encoding => 'Base64', - description => $filename, - ctype => $query->uploadInfo($filename)->{'Content-Type'}, - disposition => "attachment; filename = $filename", - file => $tmp_file - }); - $sender->Close(); - - print "Content-type: text/plain\n\nYes, it's sent\n\n"; - -=head2 Listing the authentication protocols supported by the server - - use Mail::Sender; - my $sender = new Mail::Sender {smtp => 'localhost'}; - die "Error: $Mail::Sender::Error\n" unless ref $sender; - print join(', ', $sender->QueryAuthProtocols()),"\n"; - -or (if you have Mail::Sender 0.8.05 or newer) - - use Mail::Sender; - print join(', ', Mail::Sender->QueryAuthProtocols('localhost')),"\n"; - -or - - use Mail::Sender; - print join(', ', Mail::Sender::QueryAuthProtocols('localhost')),"\n"; - -=head2 FAQ - -=head3 Forwarding the messages created by Mail::Sender removes accents. Why? - -The most likely colprit is missing or incorrect charset specified for the body or -a part of the email. You should add something like - - charset => 'iso-8859-1', - encoding => 'quoted-printable', - -to the parameters passed to Open(), OpenMultipart(), MailMsg(), Body() or Part() or - - b_charset => 'iso-8859-1', - b_encoding => 'quoted-printable', - -to the parameters for MailFile(). - -If you use a different charset ('iso-8859-2', 'win-1250', ...) you will of course need -to specify that charset. If you are not sure, try to send a mail with some other mail client -and then look at the message/part headers. - -=head2 Sometimes there is an equals sign at the end of an attached file when -I open the email in Outlook. What's wrong? - -Outlook is. It has (had) a bug in its quoted printable decoding routines. -This problem happens only in quoted-printable encoded parts on multipart messages. -And only if the data in that part do not end with a newline. (This is new in 0.8.08, in older versions -it happened in all QP encoded parts.) - -The problem is that an equals sign at the end of a line in a quoted printable encoded text means -"ignore the newline". That is - - fooo sdfg sdfg sdfh dfh = - dfsgdsfg - -should be decoded as - - fooo sdfg sdfg sdfh dfh dfsgdsfg - -The problem is at the very end of a file. The part boundary (text separating different -parts of a multipart message) has to start on a new line, if the attached file ends by a newline everything is cool. -If it doesn't I need to add a newline and to denote that the newline is not part of the original file I add an equals: - - dfgd dsfgh dfh dfh dfhdfhdfhdfgh - this is the last line.= - --message-boundary-146464-- - -Otherwise I'd add a newline at the end of the file. -If you do not care about the newline and want to be sure Outlook doesn't add the equals to the file add - - bypass_outlook_bug => 1 - -parameter to C or C/C. - -=head2 WARNING - -DO NOT mix Open(Multipart)|Send(Line)(Ex)|Close with MailMsg or MailFile. -Both Mail(Msg/File) close any Open-ed mail. -Do not try this: - - $sender = new Mail::Sender ...; - $sender->OpenMultipart...; - $sender->Body; - $sender->Send("..."); - $sender->MailFile({file => 'something.ext'); - $sender->Close; - -This WON'T work!!! - -=head2 GOTCHAS - -=head3 Local user "someone@somewhere.com" doesn't exist - -"Thanks" to spammers mail servers usualy do not allow just anyone to post a message through them. -Most often they require that either the sender or the recipient is local to the server - -=head3 Mail::Sendmail works, Mail::Sender doesn't - -If you are able to connect to the mail server and scripts using Mail::Sendmail work, but Mail::Sender fails with -"connect() failed", please review the settings in /etc/services. The port for SMTP should be 25. - -=head3 $/ and $\ - -If you change the $/ ($RS, $INPUT_RECORD_SEPARATOR) or $\ ($ORS, $OUTPUT_RECORD_SEPARATOR) -or $, ($OFS, $OUTPUT_FIELD_SEPARATOR) Mail::Sender may stop working! Keep in mind that those variables are global -and therefore they change the behaviour of <> and print everywhere. -And since the SMTP is a plain text protocol if you change the notion of lines you can break it. - -If you have to fiddle with $/, $\ or $, do it in the smallest possible block of code and local()ize the change! - - open my $IN, '<', $filename or die "Can't open $filename: $!\n"; - my $data = do {local $/; <$IN>}; - close $IN; - -=head1 BUGS - -I'm sure there are many. Please let me know if you find any. - -The problem with multiline responses from some SMTP servers (namely qmail) is solved. At last. - -=head1 SEE ALSO - -MIME::Lite, MIME::Entity, Mail::Sendmail, Mail::Mailer, ... - -There are lots of mail related modules on CPAN, with different capabilities and interfaces. You -have to find the right one yourself :-) - -=head1 DISCLAIMER - -This module is based on SendMail.pm Version : 1.21 that appeared in -Perl-Win32-Users@activeware.com mailing list. I don't remember the name -of the poster and it's not mentioned in the script. Thank you mr. C. - -=head1 AUTHOR - -Jan Krynicky -http://Jenda.Krynicky.cz - -With help of Rodrigo Siqueira , -Ed McGuigan , -John Sanche , -Brian Blakley , -and others. - -=head1 COPYRIGHT - -Copyright (c) 1997-2006 Jan Krynicky . All rights reserved. - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. There is only one aditional condition, you may -NOT use this module for SPAMing! NEVER! (see http://spam.abuse.net/ for definition) - -=cut diff --git a/Maintenance/svn_server/hooks/Mail/Sender/CType/Ext.pm b/Maintenance/svn_server/hooks/Mail/Sender/CType/Ext.pm deleted file mode 100755 index 957e9929d74..00000000000 --- a/Maintenance/svn_server/hooks/Mail/Sender/CType/Ext.pm +++ /dev/null @@ -1,208 +0,0 @@ -package Mail::Sender; -%Mail::Sender::CTypes = -( -#------------------------------------------ -'HTML', "text/html", -'HTM', "text/html", -'STM', "text/html", -'SHTML', "text/html", -'TXT', "text/plain", -'PREF', "text/plain", -'AIS', "text/plain", -'RTX', "text/richtext", -'TSV', "text/tab-separated-values", -'NFO', "text/warez-info", -'ETX', "text/x-setext", -'SGML', "text/x-sgml", -'SGM', "text/x-sgml", -'TALK', "text/x-speech", -'CGI', "text/plain", # we want these two as text files -'PL', "text/plain", # and not application/x-httpd-cgi -#----------------------------------------- -'COD', "image/cis-cod", -'FID', "image/fif", -'GIF', "image/gif", -'ICO', "image/ico", -'IEF', "image/ief", -'JPEG', "image/jpeg", -'JPG', "image/jpeg", -'JPE', "image/jpeg", -'PNG', "image/png", -'TIF', "image/tiff", -'TIFF', "image/tiff", -'MCF', "image/vasa", -'RAS', "image/x-cmu-raster", -'CMX', "image/x-cmx", -'PCD', "image/x-photo-cd", -'PNM', "image/x-portable-anymap", -'PBM', "image/x-portable-bitmap", -'PGM', "image/x-portable-graymap", -'PPM', "image/x-portable-pixmap", -'RGB', "image/x-rgb", -'XBM', "image/x-xbitmap", -'XPM', "image/x-xpixmap", -'XWD', "image/x-xwindowdump", -#------------------------------------------ -'EXE', "application/octet-stream", -'BIN', "application/octet-stream", -'DMS', "application/octet-stream", -'LHA', "application/octet-stream", -'CLASS', "application/octet-stream", -'DLL', "application/octet-stream", -'AAM', "application/x-authorware-map", -'AAS', "application/x-authorware-seg", -'AAB', "application/x-authorware-bin", -'VMD', "application/vocaltec-media-desc", -'VMF', "application/vocaltec-media-file", -'ASD', "application/astound", -'ASN', "application/astound", -'DWG', "application/autocad", -'DSP', "application/dsptype", -'DFX', "application/dsptype", -'EVY', "application/envoy", -'SPL', "application/futuresplash", -'IMD', "application/immedia", -'HQX', "application/mac-binhex40", -'CPT', "application/mac-compactpro", -'DOC', "application/msword", -'ODA', "application/oda", -'PDF', "application/pdf", -'AI', "application/postscript", -'EPS', "application/postscript", -'PS', "application/postscript", -'PPT', "application/powerpoint", -'RTF', "application/rtf", -'APM', "application/studiom", -'XAR', "application/vnd.xara", -'ANO', "application/x-annotator", -'ASP', "application/x-asap", -'CHAT', "application/x-chat", -'BCPIO', "application/x-bcpio", -'VCD', "application/x-cdlink", -'TGZ', "application/x-compressed", -'Z', "application/x-compress", -'CPIO', "application/x-cpio", -'PUZ', "application/x-crossword", -'CSH', "application/x-csh", -'DCR', "application/x-director", -'DIR', "application/x-director", -'DXR', "application/x-director", -'FGD', "application/x-director", -'DVI', "application/x-dvi", -'LIC', "application/x-enterlicense", -'EPB', "application/x-epublisher", -'FAXMGR', "application/x-fax-manager", -'FAXMGRJOB', "application/x-fax-manager-job", -'FM', "application/x-framemaker", -'FRAME', "application/x-framemaker", -'FRM', "application/x-framemaker", -'MAKER', "application/x-framemaker", -'GTAR', "application/x-gtar", -'GZ', "application/x-gzip", -'HDF', "application/x-hdf", -'INS', "application/x-insight", -'INSIGHT', "application/x-insight", -'INST', "application/x-install", -'IV', "application/x-inventor", -'JS', "application/x-javascript", -'SKP', "application/x-koan", -'SKD', "application/x-koan", -'SKT', "application/x-koan", -'SKM', "application/x-koan", -'LATEX', "application/x-latex", -'LICMGR', "application/x-licensemgr", -'MAIL', "application/x-mailfolder", -'MIF', "application/x-mailfolder", -'NC', "application/x-netcdf", -'CDF', "application/x-netcdf", -'SDS', "application/x-onlive", -'SGI-LPR', "application/x-sgi-lpr", -'SH', "application/x-sh", -'SHAR', "application/x-shar", -'SWF', "application/x-shockwave-flash", -'SPRITE', "application/x-sprite", -'SPR', "application/x-sprite", -'SIT', "application/x-stuffit", -'SV4CPIO', "application/x-sv4cpio", -'SV4CRC', "application/x-sv4crc", -'TAR', "application/x-tar", -'TARDIST', "application/x-tardist", -'TCL', "application/x-tcl", -'TEX', "application/x-tex", -'TEXINFO', "application/x-texinfo", -'TEXI', "application/x-texinfo", -'T', "application/x-troff", -'TR', "application/x-troff", -'TROFF', "application/x-troff", -'MAN', "application/x-troff-man", -'ME', "application/x-troff-me", -'MS', "application/x-troff-ms", -'TVM', "application/x-tvml", -'TVM', "application/x-tvml", -'USTAR', "application/x-ustar", -'SRC', "application/x-wais-source", -'WKZ', "application/x-wingz", -'ZIP', "application/x-zip-compressed", -'ZTARDIST', "application/x-ztardist", -#-------------------------------------