hi all,
I just saw the following lines in Dmitry's Mail: Re: [xmail] Re: Frozen messages
`./CtrlClnt -s $server -u $postmaster -p $password frozlist > froz.txt`;
open (FF, "<froz.txt");
....
and thought, that looked ugly.....
this is what I have written to include XMail in my perl-applications
a while ago.... the most important functions are included here. even
virus-checking!
feel free to add, modify or copy this code... it's a beginning of a possible
perl-API for XMail. The frozlist command does not exist here, but could
easily be added.
--snip--
#
# XMail.pm - written by [EMAIL PROTECTED]
#
package XMail;
use strict;
use Carp;
use Socket;
use vars qw(@ISA @EXPORT);
use Digest::MD5 qw(md5_hex);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
xmConnect
xmRead
xmWrite
xmDisconnect
xmSecureUserAdd
xmUserAdd
xmListAdd
xmUserDel
xmListDel
xmUser
xmUserList
xmDomainAdd
xmDomainDel
xmDomain
xmAlias
xmAliasAdd
xmAliasDel
xmAliasList
xmDomainList
xmForwarderAdd
xmMlUserDel
xmMlUserAdd
xmMlUserList
xmUserPasswd
xmCheckMailbox
xmGetRedirects
xmUserGetMproc
xmUserSetMproc
xmUserVarsSet
);
##############################################################################
sub xmConnect {
my ($remote,$port,$user,$password)=@_;
if (!$remote) {
$remote="default.mailserver.com"; # put your default server here
$port=6017; # default controll port
$user="username"; # default username
$password="password"; # default passwort
}
my $proto=getprotobyname('tcp');
my $iaddr=inet_aton($remote) or die "no such host: $remote";
my $paddr=sockaddr_in($port,$iaddr);
socket(XMAIL,PF_INET,SOCK_STREAM,$proto);
connect(XMAIL, $paddr);
my ($code,$line)=xmRead();
my $string;
if ($line=~/(<.*>)/) {
$string=$1;
}
xmWrite("$user\t#".md5_hex($string.$password));
}
sub xmRead {
my $line=<XMAIL>;
my ($z,$c,$t);
if ($line=~/^(\W)(\d{5}) (.+)$/) {
$z=$1;
$c=int($2);
$t=$3;
}
return ($c,$line);
}
sub xmWrite {
my $command=shift;
if (!defined(send(XMAIL,"$command\n",""))) {
die "Could not write to XMAIL-Socket";
}
return xmRead();
}
sub xmDisconnect {
close(XMAIL) or die "close: $!";
}
sub xmUserList {
my ($domain,$username)=@_;
my $command="userlist";
if ($domain) {
$command.="\t$domain";
if ($username) {
$command.="\t$username";
}
}
my @list=xmArray($command);
return sort @list;
}
sub xmAliasList {
my ($domain,$username)=@_;
my $command="aliaslist";
if ($domain) {
$command.="\t$domain";
if ($username) {
$command.="\t$username";
}
}
my @list=xmArray($command);
return sort @list;
}
sub xmUser {
my ($domain,$username)=@_;
my @userlist=xmUserList($domain,$username);
if ($userlist[0]) {
return 1;
} else {
return 0;
}
}
sub xmAlias {
my ($domain,$username)=@_;
my @userlist=xmAliasList($domain,$username);
if ($userlist[0]) {
return 1;
} else {
return 0;
}
}
sub xmUserAdd {
my ($domain,$username,$password)=@_;
if (!xmDomain($domain)) {
xmDomainAdd($domain);
}
if (xmUser($domain,$username)) {
print "User exists: $username in domain $domain\n";
return 0;
} else {
xmWrite("useradd\t$domain\t$username\t$password\tU");
return 1;
}
}
sub xmListAdd {
my ($domain,$username)=@_;
if (!xmDomain($domain)) {
xmDomainAdd($domain);
}
if (xmUser($domain,$username)) {
print "User exists: $username in domain $domain\n";
return 0;
} else {
xmWrite("useradd\t$domain\t$username\tbogus\tM");
return 1;
}
}
sub xmUserDel {
my ($domain,$username)=@_;
xmWrite("userdel\t$domain\t$username");
}
sub xmListDel {
my ($domain,$username)=@_;
xmUserDel($domain,$username);
}
sub xmDomainAdd {
my $domain=shift;
xmWrite("domainadd\t$domain");
}
sub xmDomainDel {
my $domain=shift;
xmWrite("domaindel\t$domain");
}
sub xmArray {
my $command=shift;
if (!defined(send(XMAIL,"$command\n",""))) {
die "Could not write to XMAIL-Socket";
}
my @array;
if (xmRead()==100) {
my $line=<XMAIL>;
while ($line ne ".\r\n") {
$line=~s/\r\n$//;
$line=~s/\"//g;
push(@array,$line);
$line=<XMAIL>;
}
return @array;
} else {
return ();
}
}
sub xmDomainList {
my @list=xmArray("domainlist");
return (sort @list);
}
sub xmDomain {
my $domain=shift;
my @domainlist=xmDomainList($domain);
my $merker=0;
for my $i(0..$#domainlist) {
if ($domainlist[$i] eq $domain) {
$merker=1;
}
}
return $merker;
}
sub xmAliasAdd {
my ($domain,$alias,$username)=@_;
return xmWrite("aliasadd\t$domain\t$alias\t$username");
}
sub xmAliasDel {
my ($domain,$alias)=@_;
return xmWrite("aliasdel\t$domain\t$alias");
}
sub xmForwarderAdd {
my ($domain,$alias,$redirect,$mailbox)=@_;
if (xmUserAdd($domain,$alias,"bogus")) {
xmUserSetMproc($domain,$alias,$redirect,$mailbox);
xmUserVarsSet($domain,$alias,"PopEnable",0);
}
}
sub xmSecureUserAdd {
my ($domain,$username,$password)=@_;
if (xmUserAdd($domain,$username,$password)) {
my $command="cfgfileset\tfilters/$username\@$domain.tab\n";
$command.='"/var/MailRoot/avfilter/viruscheck.pl" "@@FILE" "@@FROM" "@@RCPT"'."\n.";
xmWrite($command);
}
}
sub xmMlUserAdd {
my ($domain,$mlusername,$email,$perm)=@_;
xmWrite("mluseradd\t$domain\t$mlusername\t$email\t$perm");
}
sub xmMlUserDel {
my ($domain,$mlusername,$email)=@_;
xmWrite("mluserdel\t$domain\t$mlusername\t$email");
}
sub xmMlUserList {
my ($domain,$mlusername)=@_;
return xmArray("mluserlist\t$domain\t$mlusername");
}
sub xmUserPasswd {
my ($domain,$user,$pass)=@_;
xmWrite("userpasswd\t$domain\t$user\t$pass");
}
sub xmUserGetMproc {
my ($domain,$user)=@_;
return xmArray("usergetmproc\t$domain\t$user");
}
sub xmUserSetMproc {
my ($domain,$user)=@_;
return xmArray("usergetmproc\t$domain\t$user");
}
sub xmCheckMailbox {
my ($domain,$user)=@_;
my $merker=0;
if (xmUser($domain,$user)) {
my @mproc=xmUserGetMproc($domain,$user);
if ($mproc[0]) {
for my $i(0..$#mproc) {
if ($mproc[$i]=~/^mailbox/i) {
$merker=1;
last;
}
}
} else {
$merker=1;
}
}
return $merker;
}
sub xmGetRedirects {
my ($domain,$user)=@_;
if (xmUser($domain,$user)) {
my @mproc=xmUserGetMproc($domain,$user);
my @redirects;
for my $i(0..$#mproc) {
if ($mproc[$i]=~/^redirect\t(.+)/i) {
push(@redirects,$1);
}
}
return @redirects;
} else {
return ();
}
}
sub xmUserSetMproc {
my ($domain,$user,$redirect,$mailbox)=@_;
my $command="usersetmproc\t$domain\t$user\n";
my @empfaenger=split(/\s+/,$redirect);
for my $i(0..$#empfaenger) {
$command.="redirect\t$empfaenger[$i]\n";
}
$command.="mailbox\n" if $mailbox;
xmWrite($command.".\n");
}
sub xmUserVarsSet {
my ($domain,$user,$varname,$varvalue)=@_;
my $command="uservarsset\t$domain\t$user\t$varname\t$varvalue\n";
xmWrite($command.".\n");
}
--snip--
enjoy it...
Kind regards
Henrik Steffen
Geschäftsführer
top concepts Internetmarketing GmbH
Am Steinkamp 7 - D-21684 Stade - Germany
--------------------------------------------------------
http://www.topconcepts.com Tel. +49 4141 991230
mail: [EMAIL PROTECTED] Fax. +49 4141 991233
--------------------------------------------------------
24h-Support Hotline: +49 1908 34697 (EUR 1.86/Min,topc)
--------------------------------------------------------
System-Partner gesucht: http://www.franchise.city-map.de
--------------------------------------------------------
Handelsregister: AG Stade HRB 5811 - UstId: DE 213645563
--------------------------------------------------------
----- Original Message -----
From: "Dmitry" <[EMAIL PROTECTED]>
To: "Rickard Martinsson" <[EMAIL PROTECTED]>
Sent: Friday, August 02, 2002 1:38 PM
Subject: [xmail] Re: Frozen messages
-
To unsubscribe from this list: send the line "unsubscribe xmail" in
the body of a message to [EMAIL PROTECTED]
For general help: send the line "help" in the body of a message to
[EMAIL PROTECTED]
