gunnar: server/perl-kolab/perl-kolab/bin .cvsignore, NONE, 1.1 kolab_smtpdpolicy.in, NONE, 1.1 kolabdcachetool.in, NONE, 1.1 kolabpasswd.in, NONE, 1.1 kolabquotareport.in, NONE, 1.1 kolabquotawarn.in, NONE, 1.1
cvs at kolab.org
cvs at kolab.org
Tue Feb 16 06:33:44 CET 2010
- Previous message: gunnar: server/perl-kolab/perl-kolab/data/etc quotawarning.txt, NONE, 1.1
- Next message: gunnar: server/perl-kolab/perl-kolab/lib/Kolab Conf.pm, NONE, 1.1 Cyrus.pm, NONE, 1.1 LDAP.pm, NONE, 1.1 Util.pm, NONE, 1.1
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Author: gunnar
Update of /kolabrepository/server/perl-kolab/perl-kolab/bin
In directory doto:/tmp/cvs-serv3473/perl-kolab/bin
Added Files:
.cvsignore kolab_smtpdpolicy.in kolabdcachetool.in
kolabpasswd.in kolabquotareport.in kolabquotawarn.in
Log Message:
Move the perl-kolab sources into their own subdirectory.
--- NEW FILE: .cvsignore ---
kolab_smtpdpolicy
kolabdcachetool
kolabpasswd
kolabquotareport
kolabquotawarn
--- NEW FILE: kolab_smtpdpolicy.in ---
#!perl
=head1 NAME
kolab_smtpdpolicy - Kolab SMTP policy
=head1 SYNOPSIS
B<kolab_smtpdpolicy> [B<-v>]
=head1 DESCRIPTION
kolabdelegated Postfix SMTPD policy server for Kolab. This server implements
various policies for Kolab:
1) Only authenticated users can use sender <username>@$domain
2) Some distribution lists are only available to authenticated users
Logging is sent to syslogd.
How it works: each time a Postfix SMTP server process is started
it connects to the policy service socket, and Postfix runs one
instance of this PERL script. By default, a Postfix SMTP server
process terminates after 100 seconds of idle time, or after serving
100 clients. Thus, the cost of starting this PERL script is smoothed
out over time.
To run this from /etc/postfix/master.cf:
policy unix - n n - - spawn
user=kolab-n argv=/usr/bin/perl /usr/libexec/postfix/kolab_smtpdpolicy
To use this from Postfix SMTPD, use in /etc/postfix/main.cf:
smtpd_recipient_restrictions =
...
reject_unauth_destination
check_policy_service unix:private/policy
...
smtpd_sender_restrictions =
...
check_policy_service unix:private/policy
...
NOTE: specify check_policy_service AFTER reject_unauth_destination
or else your system can become an open relay.
To test this script by hand, execute kolab_smtpdpolicy, optionally
with the option -v to print debugging output.
Example for OpenPKG based installations:
# su - kolab
$ /kolab/etc/kolab/kolab_smtpdpolicy -v
Each query is a bunch of attributes. Order does not matter, and
the demo script uses only a few of all the attributes shown below:
request=smtpd_access_policy
protocol_state=RCPT
protocol_name=SMTP
helo_name=some.domain.tld
queue_id=8045F2AB23
sender=foo at bar.tld
recipient=bar at foo.tld
client_address=1.2.3.4
client_name=another.domain.tld
instance=123.456.7
sasl_method=plain
sasl_username=you
sasl_sender=
size=12345
[empty line]
The policy server script will answer in the same style, with an
attribute list followed by a empty line:
action=DUNNO
[empty line]
=head1 OPTIONS AND ARGUMENTS
=over 8
=item B<-v>
=back
=head1 COPYRIGHT AND AUTHORS
See AUTHORS file
=head1 LICENSE
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You can view the GNU General Public License, online, at the GNU
Project's homepage; see <http://www.gnu.org/licenses/gpl.html>.
=cut
## $Revision: 1.1 $
use strict;
use Fcntl;
use Sys::Syslog qw(:DEFAULT setlogsock);
use URI;
use Net::LDAP qw(LDAP_NO_SUCH_OBJECT);
use Net::LDAP::Entry;
use Net::hostent;
use Socket;
use Kolab::Util;
#
# Syslogging options for verbose mode and for fatal errors.
# NOTE: comment out the $syslog_socktype line if syslogging does not
# work on your system.
#
my %conf;
my %attr;
my $ldap;
my $verbose;
my $syslog_socktype = 'unix'; # inet, unix, stream, console
my $syslog_facility="mail";
my $syslog_options="pid";
my $syslog_priority="info";
my $ldap_max_tries = 5;
#
# Read options from config-file
#
my $conf_allowunauth = 0;
%conf = readConfig( %conf, "@CONFIG_DIR@/kolab_smtpdpolicy.conf" );
my $conf_ldapuri = $conf{'ldap_uri'};
my $conf_basedn = $conf{'basedn'};
my $conf_binddn = $conf{'binddn'};
my $conf_bindpw = $conf{'bindpw'};
my @conf_domain = $conf{'domain'};
$conf_allowunauth = 1 if( $conf{'allow_unauth'} );
my @conf_permithosts = split /\s*,\s*/, $conf{'permithosts'};
sub mylog {
my $prio = shift;
my $fmt = shift;
my $text = sprintf( $fmt, @_ );
#Kolab::log( 'P', $text );
syslog $prio, $text;
print "$text\n";
}
sub contains {
my $needle = lc(shift);
my $haystack = shift;
map { return 1 if $needle eq lc($_) } @$haystack;
return 0;
}
sub ldap_connect {
my $ldapuri = URI->new($conf_ldapuri) || fatal_exit("error: could not parse given uri $conf_ldapuri");
$ldap = Net::LDAP->new($conf_ldapuri) || fatal_exit("could not connect ldap server $conf_ldapuri: $@");
if ($ldap) {
if( $conf_binddn ) {
$ldap->bind( $conf_binddn, password => $conf_bindpw )
|| fatal_exit( "could not bind as $conf_binddn: $@" );
} else {
$ldap->bind || fatal_exit("could not bind: $@");
}
} else {
fatal_exit( "Could not contact LDAP server" );
}
}
sub lookup_uid {
my $tries = 0;
my $uid = shift;
AGAIN:
my $mesg = $ldap->search( base=> $conf_basedn,
scope=> 'sub',
filter=> "(&(objectClass=kolabinetorgperson)(|(mail=$uid)(uid=$uid)))",
attrs => [ 'uid'] );
if( !$mesg->code && $mesg->count() > 0 ) {
mylog($syslog_priority, "LDAP search returned ".$mesg->count()." objects") if $verbose;
my $ldapobject = $mesg->entry(0);
$uid = lc($ldapobject->get_value('uid'));
mylog($syslog_priority, "Translated username to $uid") if $verbose;
} elsif( $mesg->code && $mesg->code != LDAP_NO_SUCH_OBJECT ) {
if( $tries++ <= $ldap_max_tries ) {
ldap_connect;
goto AGAIN;
} else {
mylog($syslog_priority, "LDAP Connection error during LOOKUPUID: ".
$mesg->error." after $ldap_max_tries attempts to reconnect. Giving up!" );
die( "LDAP Error looking up uid: ".$mesg->error );
}
}
return $uid;
}
sub check_permithosts {
my $client_addr = shift;
for my $host (@conf_permithosts) {
my $h;
unless ($h = gethost($host)) {
mylog($syslog_priority,"No such host $host\n");
next;
}
for my $addr ( @{$h->addr_list} ) {
return 1 if inet_ntoa($addr) eq $client_addr;
}
}
return undef;
}
sub lookup_sender_uids {
my $sender = shift;
my $tries = 0;
my @result;
AGAIN:
my $mesg = $ldap->search( base=> $conf_basedn,
scope=> 'sub',
filter=> "(&(objectClass=kolabinetorgperson)(|(mail=$sender)(alias=$sender)))",
attrs => [ 'uid', 'kolabDelegate' ]);
if( !$mesg->code && $mesg->count() > 0 ) {
mylog($syslog_priority, "LDAP search returned ".$mesg->count()." objects") if $verbose;
foreach my $entry ( $mesg->entries ) {
mylog($syslog_priority, lc($entry->get_value('uid')." is the uid of ".$sender)) if $verbose;
push @result, lc($entry->get_value('uid'));
my $delegate;
for $delegate ($entry->get_value('kolabDelegate')) {
$delegate = lookup_uid($delegate);
mylog($syslog_priority, lc($delegate)." is a delegate of ".$sender) if $verbose;
push @result, lc($delegate);
}
}
} elsif( $mesg->code && $mesg->code != LDAP_NO_SUCH_OBJECT ) {
if( $tries++ <= $ldap_max_tries ) {
ldap_connect;
goto AGAIN;
} else {
die( "LDAP Error looking up uid for sender: ".$mesg->error );
}
}
return @result;
};
sub check_dist_list {
my $username = shift;
my $recipient = shift;
my $tries = 0;
AGAIN:
if( !$username ) {
my $mesg = $ldap->search( base=> "cn=internal,".$conf_basedn,
scope=> 'one', filter=> "(&(mail=$recipient)(objectClass=kolabgroupofnames))");
if( !$mesg->code && $mesg->count() > 0 ) {
# Ups, recipient is a restricted list, reject
mylog( $syslog_priority, "Attempt from $username to access restricted list $recipient" ) if $verbose;
return undef;
} elsif( $mesg->code && $mesg->code != LDAP_NO_SUCH_OBJECT && $tries++ <= $ldap_max_tries ) {
mylog($syslog_priority, "LDAP Connection error during CHECKDISTLIST: ".$mesg->error.", trying to reconnect" );
ldap_connect;
goto AGAIN;
} elsif( $mesg->code ) {
mylog( $syslog_priority, "LDAP Error during CHECKDISTLIST: ".$mesg->error ) if $verbose;
# Just fall through and accept the message in case there was an LDAP problem.
}
}
return 1;
}
sub check_restricted_sender {
my $username = shift;
my $recipient = shift;
my $tries = 0;
AGAIN:
my $mesg = $ldap->search( base=> $conf_basedn,
scope=> 'sub',
filter=> "(&(objectClass=kolabinetorgperson)(|(mail=$username)(uid=$username)))",
attrs => [ 'kolabAllowSMTPRecipient' ]);
if( !$mesg->code && $mesg->count() > 0 ) {
mylog($syslog_priority, "LDAP search returned ".$mesg->count()." objects") if $verbose;
my $global_permit = 1;
foreach my $entry ( $mesg->entries ) {
my $allowed_recipient;
my $permit;
for $allowed_recipient ($entry->get_value('kolabAllowSMTPRecipient')) {
mylog($syslog_priority, lc($username." has allowed recipient ".$allowed_recipient)) if $verbose;
# Return early with REJECT if the sender may not send at all ('-')
return undef if $allowed_recipient eq '-';
# Check if the entry is a negation (leading '-')
if ( $allowed_recipient =~ /^-(.*)/ ) {
$permit = undef;
$allowed_recipient = $1;
} else {
# Once there is a non-negating entry we need REJECT if no rule matched
$global_permit = undef;
$permit = 1;
}
if ( $allowed_recipient =~ /@/ ) {
# If the entry contains '@' the leading segment must match
return $permit if $recipient =~ /^$allowed_recipient/;
} elsif ( $allowed_recipient =~ /^\.(.*)/ ) {
# If the entry starts with '.' the trailing domain must match
return $permit if $recipient =~ /${1}$/;
} else {
# All other entries must match the last part of the mail address
return $permit if $recipient =~ /\@${allowed_recipient}$/;
}
}
}
# Allow sending if there was no entry or no negated entry rejected
return $global_permit;
} elsif( $mesg->code && $mesg->code != LDAP_NO_SUCH_OBJECT && $tries++ <= $ldap_max_tries ) {
mylog($syslog_priority, "LDAP Connection error during CHECKRESTRICTEDSENDER: ".$mesg->error.", trying to reconnect" );
ldap_connect;
goto AGAIN;
} elsif( $mesg->code ) {
mylog( $syslog_priority, "LDAP Error during CHECKRESTRICTEDSENDER: ".$mesg->error ) if $verbose;
# Just fall through and accept the message in case there was an LDAP problem.
}
return 1;
}
#
# SMTPD access policy routine. The result is an action just like
# it would be specified on the right-hand side of a Postfix access
# table. Request attributes are available via the %attr hash.
#
sub smtpd_access_policy {
# Get relevant attributes
my $sender = lc($attr{'sender'});
my $recipient = lc($attr{'recipient'});
my $username = lc($attr{'sasl_username'});
my $client_addr = lc($attr{'client_address'});
mylog($syslog_priority, "Checking sender=\"$sender\", recipient=\"$recipient\", username=\"$username\", domains=".join(',', at conf_domain)." permithosts=".join(',', at conf_permithosts).", conf_allowunauth=$conf_allowunauth") if $verbose;
# First check if the sender is a privileged kolabhost
# Kolab hosts use un-authenticated smtp currently
# We also just accept the email here is conf_allowunauth is set
return "DUNNO" if( !$username && ( $conf_allowunauth || check_permithosts($client_addr) ) );
# Reject anything else from unauthenticated users
# if conf_allowunauth is false
return "REJECT Access denied" if( !$username && !$conf_allowunauth );
eval{ $username = lookup_uid($username) }; return "DEFER_IF_PERMIT $@" if $@;
# Check for valid access from a restricted sender
return "REJECT Recipient denied" unless check_restricted_sender($username, $recipient);
# See if sender is owned by someone
my @uids;
eval { @uids = lookup_sender_uids($sender) }; return "DEFER_IF_PERMIT $@" if $@;
if( scalar(@uids) > 0 ) {
if( contains( $username, \@uids ) ) {
mylog($syslog_priority, "$username using $sender is OK, accepting") if $verbose;
return "DUNNO";
} else {
mylog($syslog_priority, "$username trying to use $sender is NOT OK, rejecting") if $verbose;
return "REJECT Invalid sender";
}
} else {
# OK, here things get fishy! The above check
# ensures that nobody is using someone else's
# email address. That is perfectly valid, but
# people want tighter restrictions and disallow
# use of _any_ (real or imagined) email address
# that the user is not explicitly allowed to use.
# Do _have_ to allow the empty sender though,
# otherwise hell breaks loose...
if( $username ne '' && $sender ne '' ) {
mylog($syslog_priority, "$username trying to use $sender is NOT OK, rejecting") if $verbose;
return "REJECT Invalid sender";
}
}
# Check for valid access to restricted distribution lists
return "REJECT Access denied" unless check_dist_list($username, $recipient);
# The result can be any action that is allowed in a Postfix access(5) map.
#
# To label mail, return ``PREPEND'' headername: headertext
#
# In case of success, return ``DUNNO'' instead of ``OK'' so that the
# check_policy_service restriction can be followed by other restrictions.
#
# In case of failure, specify ``DEFER_IF_PERMIT optional text...''
# so that mail can still be blocked by other access restrictions.
mylog($syslog_priority, "sender $sender, recipient $recipient seems ok") if $verbose;
return "DUNNO";
}
#
# Log an error and abort.
#
sub fatal_exit {
my($first) = shift(@_);
mylog("err", "fatal: $first", @_);
print STDOUT "action=DEFER_IF_PERMIT $first\n\n";
exit 1;
}
#
# Signal 11 means that we have crashed perl
#
sub sigsegv_handler {
fatal_exit "Caught signal 11;";
}
$SIG{'SEGV'} = 'sigsegv_handler';
#
# This process runs as a daemon, so it can't log to a terminal. Use
# syslog so that people can actually see our messages.
#
setlogsock $syslog_socktype;
openlog $0, $syslog_options, $syslog_facility;
#
# Allow user to override on commandline
#
while (my $option = shift(@ARGV)) {
if ($option eq "-v") {
$verbose = 1;
} elsif ($option eq '-ldap') {
$conf_ldapuri = shift(@ARGV);
} elsif ($option eq '-basedn') {
$conf_basedn = shift(@ARGV);
} elsif ($option eq '-binddn' ) {
$conf_binddn = shift(@ARGV);
} elsif ($option eq '-bindpw' ) {
$conf_bindpw = shift(@ARGV);
} elsif ($option eq '-domain') {
push @conf_domain, shift(@ARGV);
} elsif ($option eq '-allow-unauth') {
$conf_allowunauth = 1;
} elsif ($option eq '-permithosts') {
@conf_permithosts = ();
for my $h (split /\s*,\s*/, shift(@ARGV)) {
push @conf_permithosts, $h;
}
} else {
mylog( $syslog_priority, "Invalid option: %s. Usage: %s [-v] -ldap <uri> -basedn <base_dn> [-binddn <bind_dn> -bindpw <bind_pw>] [-domain <domain>] [-permithosts <host,host,...>]",
$option, $0);
exit 1;
}
}
#
# Unbuffer standard output.
#
select((select(STDOUT), $| = 1)[0]);
if( $verbose ) {
mylog( $syslog_priority, "ldap=$conf_ldapuri, basedn=$conf_basedn, binddn=$conf_binddn");
}
ldap_connect;
#
# Receive a bunch of attributes, evaluate the policy, send the result.
#
while (<STDIN>) {
if (/([^=]+)=(.*)\n/) {
$attr{substr($1, 0, 512)} = substr($2, 0, 512);
} elsif ($_ eq "\n") {
if ($verbose) {
for (keys %attr) {
mylog( $syslog_priority, "Attribute: %s=%s", $_, $attr{$_});
}
}
fatal_exit("unrecognized request type: '".$attr{'request'}."'")
unless $attr{'request'} eq "smtpd_access_policy";
my $action = smtpd_access_policy();
mylog( $syslog_priority, "Action: %s", $action) if $verbose;
print STDOUT "action=$action\n\n";
%attr = ();
} else {
chop;
mylog( $syslog_priority, "warning: ignoring garbage: %.100s", $_);
}
}
--- NEW FILE: kolabdcachetool.in ---
#!perl
=head1 NAME
kolabdcachetool - Kolab cache tool
=head1 SYNOPSIS
B<kolabdcachetool> I<CACHE> I<FUNCTION>
=head1 OPTIONS AND ARGUMENTS
=over 8
=item I<CACHE>
one of `mbox' or `gyard' (i.e. the cache to operate on)
=item I<FUNCTION>
one of `list', `delete' or `flush' (i.e. the function to perform on CACHE)
=back
=head1 COPYRIGHT AND AUTHORS
Stuart Bingë and others (see AUTHORS file)
=head1 LICENSE
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You can view the GNU General Public License, online, at the GNU
Project's homepage; see <http://www.gnu.org/licenses/gpl.html>.
=cut
use strict;
use Getopt::Long;
use DB_File;
use POSIX qw(strftime);
use Kolab;
my $progname = `basename $0`;
chomp($progname);
sub usage
{
print "Usage: $progname CACHE FUNCTION
where CACHE is one of `mbox' or `gyard' (i.e. the cache to operate
on) and FUNCION is one of `list', `delete' or `flush' (i.e. the
function to perform on CACHE)\n";
exit(1);
1;
}
my $cache = shift || usage;
my $func = shift || usage;
my (%db, %db2, %sorted);
usage if ($func !~ /list/i && $func !~ /del/i && $func !~ /flush/i);
Kolab::reloadConfig("@CONFIG_DIR@/kolab.globals");
if ($cache =~ /mbox/i) {
dbmopen(%db, $Kolab::config{'kolab_mailboxuiddb'}, 0666)
|| die "Unable to open mail uid cache";
} elsif ($cache =~ /gyard/i) {
dbmopen(%db, $Kolab::config{'graveyard_uidcache'}, 0666)
|| die "Unable to open graveyard uid cache";
dbmopen(%db2, $Kolab::config{'graveyard_tscache'}, 0666)
|| die "Unable to open graveyard timestamp cache";
} else { usage; }
my ($guid, $ts);
foreach $guid (keys %db) {
#$sorted{
$ts = "";
$ts = ", deleted " . strftime("%F %T", localtime($db2{$guid})) if exists($db2{$guid});
print "GUID: `$guid', mailbox: `" . $db{$guid} . "'$ts\n";
}
dbmclose(%db);
dbmclose(%db2);
--- NEW FILE: kolabpasswd.in ---
#!perl
=head1 NAME
kolabpasswd - Kolab password tool.
=head1 SYNOPSIS
B<kolabpasswd>
=head1 DESCRIPTION
The kolabpasswd script is used for changing the manager password on a Kolab Server.
In multi-location Kolab setups the script must be run on each individual host
separately.
After changing the manager password it is highly recommended to restart
the Kolab server.
In the future this utility may be enhanced to allow to change the passwords of
normal users and special system accounts.
=head1 COPYRIGHT AND AUTHORS
Copyright (c) 2004 Erfrakon
Copyright (c) 2004 Tassilo Erlewein <tassilo.erlewein at erfrakon.de>
Copyright (c) 2004 Martin Konold <martin.konold at erfrakon.de>
=head1 LICENSE
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You can view the GNU General Public License, online, at the GNU
Project's homepage; see <http://www.gnu.org/licenses/gpl.html>.
=cut
use Term::ReadKey;
use IO::File;
use File::Temp;
use Net::LDAP;
use Digest::SHA1;
use MIME::Base64;
use Kolab::Util;
use Kolab;
Kolab::reloadConfig("@CONFIG_DIR@/kolab.globals");
# won't be needed (i think)
# my $kolab_prefix = (getpwnam('kolab'))[7] || die "Error: could not determine the kolab directory prefix (e.g. /kolab)";
# Shell double-quote a string
# Borrored from Sysadm::Install
sub qquote {
my($str, $metas) = @_;
$str =~ s/([\\"])/\\$1/g;
if(defined $metas) {
$metas = '!$`' if $metas eq ":shell";
$metas =~ s/\]/\\]/g;
$str =~ s/([$metas])/\\$1/g;
}
return "\"$str\"";
}
# Hash a password
sub hashPassword {
my $pw = shift;
my $hashcmd = "$Kolab::config{'sbindir'}/slappasswd -s ".qquote($pw,":shell");
(my $hashpw = `$hashcmd`) or die $@;
chomp($hashpw);
return $hashpw;
}
# Taken from Crypt::SaltedHash
sub __generate_hex_salt {
my @keychars = (
"0", "1", "2", "3", "4", "5", "6", "7",
"8", "9", "a", "b", "c", "d", "e", "f"
);
my $length = shift || 8;
my $salt = '';
my $max = scalar @keychars;
for my $i ( 0 .. $length - 1 ) {
my $skip = $i == 0 ? 1 : 0; # don't let the first be 0
$salt .= $keychars[ $skip + int( rand( $max - $skip ) ) ];
}
return pack( "H*", $salt);
}
# Hash a password without using slappasswd
sub hashPassword2 {
my $pw = shift;
my $ctx = Digest::SHA1->new;
my $salt = __generate_hex_salt();
$ctx->add($pw);
$ctx->add($salt);
my $hashpw = '{SSHA}' . encode_base64($ctx->digest . $salt ,'');
return $hashpw;
}
# open old kolab master config file
my $kolabconfname = "@CONFIG_DIR@/kolab.conf";
# read old config data
my %config = readConfig($kolabconfname);
my $kolabconf = IO::File->new('@CONFIG_DIR@/kolab.conf','r')
|| die "kolabpasswd: Fatal Error: could not open kolab config at $kolabconfname";
my $account = 'manager';
my $account_dn = $config{'bind_dn'};
if( $#ARGV == 0 ) {
$account = $ARGV[0];
if( $account ne 'calendar' and $account ne 'nobody' and $account ne 'manager' ) {
die("$^X can only change the password for manager, nobody and calendar");
}
$account_dn =~ s/cn=manager/cn=$account/;
}
print "Changing password for $account";
# open ldap connection and verify old password
my $ldap = Net::LDAP->new( $config{'ldap_uri'})
|| die "\nkolabpasswd: Fatal Error: could not connect to LDAP Server";
do {
print "\nOld Password: ";
ReadMode 'noecho';
my $old_password = ReadLine 0; chomp $old_password;
$old_password = Encode::encode_utf8($old_password);
$mesg = $ldap->bind( $account_dn, password => $old_password ) || die "\nkolabpasswd: Failed to bind to LDAP server";
if( $mesg->code ) { print "\nError: ".$mesg->error.". Please try again\n"; }
} while ( $mesg->code );
# read in new password
print "\nNew Password for $account: ";
ReadMode 'noecho';
my $new_password = ReadLine 0; chomp $new_password;
print "\nRe-enter New Password: ";
my $new_password2 = ReadLine 0; chomp $new_password2;
print "\n";
ReadMode 'normal';
($new_password eq $new_password2) || die "Sorry, passwords do not match.\n";
$new_password = Encode::encode_utf8($new_password);
my $bind_pw_hash;
# create temporary config file
my $tmp = new File::Temp( TEMPLATE => 'tempXXXXX', DIR => '@CONFIG_DIR@', UNLINK => 0, SUFFIX => '.conf')
|| die "Error: could not create temporary file under @CONFIG_DIR@";
$tmpfilename = $tmp->filename;
$bind_pw_hash = hashPassword2($new_password);
# copy and replace old config to temporary file
foreach ($kolabconf->getlines()) {
if( $account eq 'manager' ) {
if (/^(bind_pw\s:\s).*$/) {
print $tmp $1.$new_password."\n";
} else {
if (/^(bind_pw_hash\s:\s).*$/) {
print $tmp $1.$bind_pw_hash."\n";
} else {
print $tmp $_;
}
}
} elsif( $account eq 'calendar' ) {
if (/^(calendar_pw\s:\s).*$/) {
print $tmp $1.$new_password."\n";
} else {
print $tmp $_;
}
} elsif( $account eq 'nobody' ) {
if (/^(php_pw\s:\s).*$/) {
print $tmp $1.$new_password."\n";
} else {
print $tmp $_;
}
}
}
undef $tmp;
undef $kolabconf;
# open ldap connection and update manager password
$ldap = Net::LDAP->new( $config{'ldap_uri'})
|| die "Error: could not connect LDAP Server";
$ldap->bind( $config{'bind_dn'}, password => $config{'bind_pw'} )
|| die "Error: Failed to bind as manager to LDAP Server";
$ldap->modify($account_dn, replace => {'userPassword' => $bind_pw_hash } )
|| die "Error: could not update LDAP with new manager password";
$ldap->unbind;
undef $ldap;
# move temporary file to kolab master config
rename($tmpfilename,$kolabconfname) || die "Error: could not install new $kolabconfname";
system("chown $Kolab::config{'ldapserver_usr'}:$Kolab::config{'ldapserver_grp'} $kolabconfname");
print "Password changed successfully, please be patient...\n";
# trigger kolabd to run update
system("$Kolab::config{'kolabconf_script'} > /dev/null 2>&1");
exit 0;
--- NEW FILE: kolabquotareport.in ---
#!perl
=head1 NAME
kolabquotareport - Kolab quota report tool
=head1 SYNOPSIS
B<kolabquotareport> [B<-d>]
=head1 OPTIONS AND ARGUMENTS
=over 8
=item B<-d>
=back
=head1 COPYRIGHT AND AUTHORS
Copyright (c) 2004 Klarälvdalens Datakonsult AB
Writen by Steffen Hansen <steffen at klaralvdalens-datakonsult.se>
=head1 LICENSE
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You can view the GNU General Public License, online, at the GNU
Project's homepage; see <http://www.gnu.org/licenses/gpl.html>.
=cut
## Local variables:
## mode: perl
## indent-tabs-mode: t
## tab-width: 4
## buffer-file-coding-system: utf-8
## End:
use strict;
use warnings;
use Getopt::Std;
use IO::File;
use DB_File;
use Mail::Message;
use Cyrus::IMAP::Admin;
use Kolab;
use Kolab::Util;
use Kolab::LDAP;
use vars qw($opt_d);
Kolab::reloadConfig("@CONFIG_DIR@/kolab.globals");
Kolab::LDAP::startup($Kolab::config{'kolab_statedir'});
getopts('d');
if ($opt_d) {
foreach my $key (sort keys %Kolab::config) {
print "$key : " . $Kolab::config{$key} . "\n";
}
exit 0;
}
my $warnmessage = '';
my $quotawarnpct = $Kolab::config{'cyrus-quotawarn'};
sub mailadmin {
my ( $mailbox, $used, $total, $pct ) = @_;
my $msg = $warnmessage;
my ($user) = ( $mailbox =~ /.*\/(.*)/ );
$msg =~ s/<user>/$user/;
$msg =~ s/<mailbox>/$mailbox/;
$msg =~ s/<percent>/$pct/;
$msg =~ s/<used>/$used/;
$msg =~ s/<total>/$total/;
my $mail = Mail::Message->build( From => "MAILER-DAEMON",
To => $user,
Subject => "Quota warning",
data => $msg );
$mail->send();
}
sub createreport {
my ( $cyrus, $pattern, $ref, $warnpct ) = @_;
my @mailboxes = $cyrus->list($pattern, $ref);
my @report;
foreach my $mailbox (@mailboxes) {
my $name = $mailbox->[0];
my $attr = $mailbox->[1];
my $sep = $mailbox->[2];
my %quota = $cyrus->quota($name);
if( $quota{'STORAGE'} ) {
my $used = $quota{'STORAGE'}[0];
my $total = $quota{'STORAGE'}[1];
my $pct = $used * 100 / $total;
if( $pct >= $warnpct ) {
print STDERR "$name over quota\n";
my ($user) = ( $name =~ /.*\/(.*)/ );
push(@report, "$user\t".$used." kB\t".$total." kB\n");
}
}
}
return @report;
}
### Connect to Cyrus
my $cyrus = Cyrus::IMAP::Admin->new($Kolab::config{'connect_addr'});
$cyrus || die 'Unable to connect to local Cyrus admin interface\n';
$cyrus->authenticate(
'User' => $Kolab::config{'cyrus_admin'},
'Password' => $Kolab::config{'cyrus_admin_pw'},
'mechanisms' => 'plaintext', )
|| die("Unable to authenticate with Cyrus admin interface, Error = `" . $cyrus->error. "'");
### Mail offending users
my @report = createreport( $cyrus, 'user/*', '*', $quotawarnpct );
if( scalar(@report) > 0 ) {
print STDOUT "User\tUsed\tTotal\n";
print STDOUT @report;
}
#print "\nSHARED FOLDERS:\n---------------\n";
#kolablistquotas( $cyrus, 'user.*', '*', 80 );
--- NEW FILE: kolabquotawarn.in ---
#!perl
=head1 NAME
kolabquotawarn - Kolab quota warn tool
=head1 SYNOPSIS
B<kolabquotawarn> [B<-d>]
=head1 OPTIONS AND ARGUMENTS
=over 8
=item B<-d>
=back
=head1 COPYRIGHT AND AUTHORS
Copyright (c) 2004 Klarälvdalens Datakonsult AB
Writen by Steffen Hansen <steffen at klaralvdalens-datakonsult.se>
=head1 LICENSE
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You can view the GNU General Public License, online, at the GNU
Project's homepage; see <http://www.gnu.org/licenses/gpl.html>.
=cut
## Local variables:
## mode: perl
## indent-tabs-mode: t
## tab-width: 4
## buffer-file-coding-system: utf-8
## End:
use strict;
use warnings;
use Getopt::Std;
use Sys::Syslog qw(:DEFAULT setlogsock);
use IO::File;
use DB_File;
use Mail::Message;
use Mail::Transport::SMTP;
use Cyrus::IMAP::Admin;
use Kolab;
use Kolab::Util;
use Kolab::LDAP;
use File::Basename;
use vars qw($opt_d);
Kolab::reloadConfig("@CONFIG_DIR@/kolab.globals");
Kolab::LDAP::startup($Kolab::config{'kolab_statedir'});
getopts('d');
if ($opt_d) {
foreach my $key (sort keys %Kolab::config) {
print "$key : " . $Kolab::config{$key} . "\n";
}
#exit 0;
}
#
# Syslogging options for verbose mode and for fatal errors.
# NOTE: comment out the $syslog_socktype line if syslogging does not
# work on your system.
#
my $syslog_socktype = 'unix'; # inet, unix, stream, console
my $syslog_facility="mail";
my $syslog_options="pid";
my $syslog_priority="info";
sub mylog {
my $prio = shift;
my $fmt = shift;
my $text = sprintf( $fmt, @_ );
#print STDERR "$text\n";
syslog $prio, $text;
}
#
# This process runs as a daemon, so it can't log to a terminal. Use
# syslog so that people can actually see our messages.
#
setlogsock $syslog_socktype;
openlog basename($0), $syslog_options, $syslog_facility;
#
# Log an error and abort.
#
sub fatal_exit {
my $fmt = shift;
printf( STDERR "fatal: $fmt\n", @_ );
mylog("err", "fatal: $fmt", @_);
exit 1;
}
my $verbose = 0;
my $warninterval = 60*60*24; # seconds between warnings
my $warnmessage = '';
my $quotawarnpct = $Kolab::config{'cyrus-quotawarn'};
fatal_exit( "Can't read configuration, please make sure that kolabquotawarn runs with sufficient privileges")
unless $quotawarnpct
&& $Kolab::config{'cyrus_admin'}
&& $Kolab::config{'cyrus_admin_pw'};
my %quotawarn_db;
my $warnh = new IO::File "< $Kolab::config{'kolab_quotawarning'}";
if( defined($warnh) ) {
$warnmessage = join( '', $warnh->getlines );
$warnmessage =~ s/<admin>/MAILER-DAEMON/g;
$warnh->close;
} else {
fatal_exit( "Can't open quotawarning.txt" );
}
dbmopen( %quotawarn_db, "$Kolab::config{'kolab_statedir'}/quotawarn.db", 0666 )
|| fatal_exit ('Unable to open quotawarn db');
if( $opt_d ) {
my $now = time();
print "Time is now $now\n";
print "Db:\n";
while(my ($key,$val) = each %quotawarn_db) {
print $key, ' = ', ($now-$val), "\n";
}
}
sub mailuser {
my ( $mailbox, $used, $total, $pct ) = @_;
my $msg = $warnmessage;
my ($user) = ( $mailbox =~ /.*\/(.*)/ );
$pct = sprintf("%.0f",$pct);
print "mailbox=$mailbox, user=$user, used=$used, pct=$pct\n" if $opt_d;
$msg =~ s/<user>/$user/g;
$msg =~ s/<mailbox>/$mailbox/g;
$msg =~ s/<percent>/$pct/g;
$msg =~ s/<used>/$used/g;
$msg =~ s/<total>/$total/g;
my $mail = Mail::Message->build( From => "MAILER-DAEMON",
To => $user,
Subject => "Quota warning",
"Content-Type" => "text/plain; charset=utf-8",
data => $msg );
$mail->print if $opt_d;
my $mailer = Mail::Transport::SMTP->new();
if( $mailer->send( $mail ) ) {
mylog("info", "info: Sent quota warning message to %s because quota is at %d%%", $user, $pct);
} else {
mylog("err", "error: Failed sent quota warning message to %s", $user);
}
}
sub kolablistquotas {
my ( $cyrus, $pattern, $ref, $warnpct ) = @_;
my @mailboxes = $cyrus->list($pattern, $ref);
foreach my $mailbox (@mailboxes) {
my $name = $mailbox->[0];
my $attr = $mailbox->[1];
my $sep = $mailbox->[2];
my %quota = $cyrus->quota($name);
if( $quota{'STORAGE'} ) {
my $used = $quota{'STORAGE'}[0];
my $total = $quota{'STORAGE'}[1];
my $pct = $used * 100 / $total;
if( $pct >= $warnpct ) {
print "$name is at $pct\n" if $opt_d;
my $ts = $quotawarn_db{$name};
print "ts=$ts\n" if $opt_d;
if( defined($ts) ) {
if( $ts eq "permanent" ) {
next;
} elsif( time() - $ts < $warninterval ) {
if( $pct >= 100 ) {
$quotawarn_db{$name} = "permanent";
}
next;
}
}
if( $pct >= 100 ) {
$quotawarn_db{$name} = "permanent";
} else {
$quotawarn_db{$name} = time();
}
mailuser( $name, $used, $total, $pct );
} else {
if( defined( $quotawarn_db{$name} ) ) {
delete $quotawarn_db{$name};
}
}
}
}
}
mylog( $syslog_priority, "starting up") if $verbose;
### Connect to Cyrus
my $cyrus = Cyrus::IMAP::Admin->new($Kolab::config{'connect_addr'});
$cyrus || fatal_exit( 'Unable to connect to local Cyrus admin interface' );
$cyrus->authenticate(
'User' => $Kolab::config{'cyrus_admin'},
'Password' => $Kolab::config{'cyrus_admin_pw'},
'Mechanism' => 'LOGIN', )
|| fatal_exit("Unable to authenticate with Cyrus admin interface");
### Mail offending users
kolablistquotas( $cyrus, 'user/*', '*', $quotawarnpct );
#print "\nSHARED FOLDERS:\n---------------\n";
#kolablistquotas( $cyrus, 'user.*', '*', 80 );
mylog( $syslog_priority, "shutting down") if $verbose;
- Previous message: gunnar: server/perl-kolab/perl-kolab/data/etc quotawarning.txt, NONE, 1.1
- Next message: gunnar: server/perl-kolab/perl-kolab/lib/Kolab Conf.pm, NONE, 1.1 Cyrus.pm, NONE, 1.1 LDAP.pm, NONE, 1.1 Util.pm, NONE, 1.1
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the commits
mailing list