|
|
www.lissyara.su
—> статьи
—> FreeBSD
—> почтовые системы
—> Simplemail Admin
Установка Simplemail Admin (аналог Postfix Admin)
Автор: ProFTP.
Оригинал статьи: тут и English version
email: q7u5@ukr.net
UPD: напишу сразу, написали вот patch для SQLite:
(патчил не я)
http://code.google.com/p/simplemailadmin/
Немного попатчил, чтобы появилась поддержка SQLite, пофиксил пути в
темплейтах, переписал документацию по установке.
Отличная софтина, ООП и т.д.
===
UPD2:
еще есть у меня админка, приходилось писать, для Postfix/exim + DBmail + White List для кадного ящика (с возможностями чтобы пользователь имел еще и Grey list и Black list персональный) + там еще есть "уникальная блокировка спама с помощью Captcha
блокировка спама (captcha, whitelist, blacklist, greylist для ящика)
====
Программа для администрирования виртуальных доменов в Exim, Postfix, etc
язык программирвоания: Perl
дизайн: PostfixAdmin
преимущества:
1) По страничный вывод данных;
2) Возможность добавление несколько доменов к аккаунту;
3) Логи в реальном времени и поиск по ним;
4) Объектно ориентированное программирование, более гибкая возможность интеграции и использования;
5) HTML отдельно;
6) Расширенная возможность управлениеи пользователями.
недостатки:
1) Нету автоответчика (будет);
2) Fetchmail нету.
Что нужно:
Postfix / exim / etc,
Apache 1.3.27 / Apache 2.28 / etc,
Perl (tested 5.8.8),
MySQL, SQLite, etc (tested MySQL 5.0.67)
Используется perl модули:
use HTML::Template;
use Data::Validate::Domain;
use Data::Validate::Email;
use DBI;
use DBD::MySQL;
IO::Socket;
use File::Pid;
(и всё что тянется с ними)
Установка модулей примерно так:
cd /usr/ports/databases/p5-DBD-mysql50/ && make && make install clean
(or /usr/ports/databases/p5-DBD-mysql51/)
(or *)
cd /usr/ports/www/p5-HTML-Template && make && make install clean
cd /usr/ports/dns/p5-Data-Validate-Domain && make && make install clean
cd /usr/ports/mail/p5-Data-Validate-Email && make && make install clean
cd /usr/ports/devel/p5-File-Pid && make && make install clean
etc
|
Про настройку виртуальных доменов можно посмотреть тут:
(таблицы MySQL которые в postfixadmin отличаться, но настройка не отличается)
http://high5.net/howto/
http://sys-adm.org.ua/mail/mail-howto-p1.php
http://www.lissyara.su/?id=1015
http://google.com
Patch md5crypt cyrus-sasl:
cyrus-sasl-2.1.22_md5patch_dist.rar: http://postfix.ru/viewtopic.php?t=3083
Настройка Apache под perl у меня примерно такая, но может быть разная:
AddHandler cgi-script .cgi .pl
DirectoryIndex index.pl
<Directory /usr/local/www/simplemail>
Options Indexes FollowSymLinks ExecCGI
</Directory>
(configuration can will differ)
| perl идет в режиме CGI, поэтому mod_perl не нужен.
Пароли хранятся в md5 закриптографированые (пароль+соль), штатная функция md5crypt в perl, предложенный механизм от Poul-Henning Kamp из FreeBSD http://www.usenix.org/events/usenix99/provos/provos_html/node10.html
1) Скачать архив, распаковать
ftp://ftp.lissyara.su/users/ProFTP/simplemailadmin-1.0.tar.gz
ftp://ftp.lissyara.su/users/ProFTP/simplemailadmin-1.0.zip
ftp://ftp.lissyara.su/users/ProFTP/simplemailadmin-1.0.7z
2) Права доступа
$ cd /usr/local/www/simplemail
$ chmod 640 *.pl *.ht*
$ cd /usr/local/www/simplemail/scripts/
$ chmod 640 *.pl .ht*
$ cd /usr/local/www/simplemail/lib/
$ chmod 640 *.pl .ht* *.pm
$ cd /usr/local/www/simplemail/templates/
$ chmod 640 *.css *.html
$ cd /usr/local/www/simplemail/templates/images
$ chmod 640 *.gif *.png
|
$ cd /usr/local/www/simplemail
|
права на выполняемый файл:
$ chmod 750 index.pl
$ chown www:www index.pl
|
(если работает Suexec, то поставить пользователя от которого должно работать, так же права на все файлы для него)
$ cd /usr/local/www/simplemail/scripts
| Крон скрипт:
$ chmod 700 maillog.pl
$ chown root:wheel maillog.pl
| данную вещь можно было сделать демоном, но от крона проще, по поводу безопасности смотрите сами, каталог где работает этот скрипт защищен веб сервером:
<Files *>
Order Deny,Allow
Deny from all
Allow from localhost
</Files>
| 3. Создание таблицы и пользователя MySQL
можно воспользоватся phpmysql или через консоль :
> use mysql
> CREATE DATABASE IF NOT EXISTS mail_db;
> GRANT ALL PRIVILEGES on mail_db.* to mail@localhost
IDENTIFIED BY 'pass_mail_mysql';
|
или
# DB mail_db
> USE mysql;
> INSERT INTO `user` (`Host`, `User`, `Password`)
> VALUES ('localhost','mail',password('exim'));
> INSERT INTO `db` (`Host`, `Db`, `User`, `Select_priv`)
> VALUES ('localhost','mail_db','mail','Y');
> FLUSH PRIVILEGES;
> GRANT USAGE ON exim.* TO mail@localhost;
> GRANT CREATE, SELECT, INSERT, DELETE, UPDATE ON mail_db.*
TO mail@localhost;
> CREATE DATABASE `mail_db`;
> USE `mail_db`;
| 4. Конфигурация конфига
(если путь к конфигу не такой /usr/local/www/simplemail/lib/config.pl
то нужно в файле maillog.pl откоректирвоать путь к нему
$ ee maillog.pl
require "/home/...../simplemail/lib/config.pl";
| )
файл с настройками /lib/config.pl
нужно написать имя пользвотеля, базу, пароль к MySQl и т.д.
5. Инсталяция таблиц и пароль админа.
$./install.pl passwd_admin
| первый аргумент passwd_admin - это пароль админа, который должен быть объязательно.
после выполнения install.pl будет создан аккаунт
user: Admin
pass: который будет введен
если все прошло без ошибок, то переходим http://mydomain.tld/
если не заработало, то смотрим на что ругается
ПРИМЕЧАНИЕ: при создании таблиц объязательно в таблицу users должна быть добавлена информация про пользователя Guest и Admin, это все делает install.pl
6. Crontab
*/2 * * * * root /usr/local/www/simplemail/scripts/maillog.pl
|
7. Delete install.pl
Конфиг config.pl
use CGI::Carp qw(fatalsToBrowser);
%{$se} = (
#данные про MySSQL
'db_name' => 'db',
# user from db
'db_user' => '',
'db_pass' => '',
'db_type' => 'mysql',
'db_host' => 'localhost',
# путь к шаблонам, желательно указать полный путь
# может заработать так 'dirt' => 'template/',
# или так 'dirt' => '../template/',
'dirt' => '../template/',
# url
# 'url' => 'http://domain.ltd',
# Maildir
'maildir' => '/var/spool/mail/',
#maillog file
'maillog' => '/var/log/maillog',
# Пользователь от которого работает транспорт
'transport_user' => 'virtual',
# число строк на странице (постраничный вывод)
'line_from_page' => '30', # 1, or 1000++
# Время жизни печенья для пользователей и администратора
# For an administrator with the purpose
#of safety of cookies not active, you can change
# +30s
#30 seconds from now
# +10m
# ten minutes from now
# +1h
# one hour from now
# -1d
# yesterday (i.e. "ASAP!")
# now
# immediately
# +3M
# in three months
# +10y
# in ten years time
# Thursday, 25-Apr-1999 00:40:33 GMT
# at the indicated time & date
'time_cookie_admin' => '',
# +14d - 14 day, '' - Disable
'time_cookie_users' => '+14d',
# +14d - 14 day, '' - Disable
# Включить логирование действий в Simplemail
'active_logsm' => '1',
# 1 - Enable, 0 - Disable
# Время в периоде которого хранятся эти логи
'time_which_active_logsm' => '604800',
# sec (7 day)
# Брать ли данный с /var/log/maillog
'active_logmta' => '1',
# 1 - Enable, 0 - Disable
# Число строк которые хранятся в таблице СУБД
# и берутся с maillog, если файл maillog очень большой,
#то можно поставить больше
'time_which_active_logmta' => '23000',
# max line online
# тип паролей:
# '0' - clean text
# 'md5crypt' - md5crypt
'type_passwd' => 'md5crypt',
# 'md5crypt' or '0'
# Максимальная длина пароля (6-9 is recommended)
'max_long_passwd' => '3',
# '2', '10' ...
# Максимальное число неправильно введенных паролей к Simplemail
'max_error_login' => '5',
# Время в котором блокируется пользователь,
# если вводит не правильные пароли
'max_error_login_time' => '1800',
# max time bad passwd 30min
# Кэшировать шаблоны, для быстродействия,
# в данном случае в оперативну память все идет
'blind_cache' => '1',
# 1 - Enable, 0 - Disable
# smtp_server
'smtp_server' => 'localhost',
# (рекомендуется 'localhost')
# Ящик от которого отправляется письмо
'mail_from' => '',
# '' - no email from, exemple: 'no_repley@mydomain.com'
'text_new_mailbox' => 'Welcome to your new account'
);
#unless (defined($se->{'url'})) { $se->{'url'} =
# 'http://'.$ENV{'SERVER_NAME'}.'/index.pl';}
1;
| Остальное на месте!
вот скрипт инсталятора, там по поводу оптимизации таблицы можно подправить, но мне не нужно, и вообще не целесообразно время хранить так 0000-00-00 00:00:00 (это сделано в PostfixAdmin), его лучше запаковать в маленькое int значение!
#!/usr/bin/perl
use strict;
use CGI;
use DBI;
use FindBin qw/$Bin/;
use lib "$Bin/lib";
our $se;
require "lib/config.pl";
if (!$ARGV[0]) {
print 'No Passwd from Admin';
exit;
}
BEGIN {
require 'func.pm';
}
my $func = func->new();
my $pass_admin = $func->md5crypt( $ARGV[0] ) || die 'error crypt passwd';
my $dbh = DBI->connect("DBI:$se->{db_type}:database=$se->{db_name};
host=$se->{db_host}",$se->{db_user},$se->{db_pass},
{ RaiseError => 1 }) || die $DBI::errstr;
$dbh->do(qq{ CREATE TABLE IF NOT EXISTS alias (
address varchar(255) NOT NULL default '',
goto text NOT NULL,
domain varchar(255) NOT NULL default '',
created datetime NOT NULL default '0000-00-00 00:00:00',
modified datetime NOT NULL default '0000-00-00 00:00:00',
active tinyint(1) NOT NULL default '1',
PRIMARY KEY (address),
KEY address (address)
) TYPE=MyISAM COMMENT='Simplemail - Virtual Aliases'
}) or die $dbh->errstr;
$dbh->do(qq{
CREATE TABLE IF NOT EXISTS mailbox (
username varchar(255) NOT NULL default '',
password varchar(255) NOT NULL default '',
name varchar(255) NOT NULL default '',
maildir varchar(255) NOT NULL default '',
quota int(10) NOT NULL default '0',
domain varchar(255) NOT NULL default '',
created datetime NOT NULL default '0000-00-00 00:00:00',
modified datetime NOT NULL default '0000-00-00 00:00:00',
active tinyint(1) NOT NULL default '1',
PRIMARY KEY (username),
KEY username (username)
) TYPE=MyISAM COMMENT='Simplemail - Virtual Mailboxes'
}) or die $dbh->errstr;
$dbh->do(qq{
CREATE TABLE IF NOT EXISTS admin_domain (
idname INT(11) NOT NULL,
m_alias int(7) not null,
m_mailbox int(7) not null,
m_domain int(7) not null,
mb_domain int(7) not null,
mb_mailbox int(7) not null,
PRIMARY KEY (idname)
)TYPE=MyISAM COMMENT='Simplemail - Admin Domain'
}) or die $dbh->errstr;
$dbh->do(qq{
CREATE TABLE IF NOT EXISTS domain (
idnane int(11) not null,
domain varchar(255) NOT NULL default '',
description varchar(255) NOT NULL default '',
aliases int(10) NOT NULL default '0',
mailboxes int(10) NOT NULL default '0',
maxquota int(10) NOT NULL default '0',
transport varchar(255) default NULL,
backupmx tinyint(1) NOT NULL default '0',
created datetime NOT NULL default '0000-00-00 00:00:00',
modified datetime NOT NULL default '0000-00-00 00:00:00',
active tinyint(1) NOT NULL default '1',
PRIMARY KEY (domain),
KEY domain (domain)
) TYPE=MyISAM COMMENT='Simplemail - Virtual Domains'
}) or die $dbh->errstr;
$dbh->do(qq{
CREATE TABLE IF NOT EXISTS log_smail (
action VARCHAR(20) NOT NULL,
userid INT(11) NOT NULL,
created INT(11) NOT NULL,
ip VARCHAR(100) NOT NULL,
forwarded VARCHAR(100) NOT NULL,
KEY userid (userid)
) TYPE=MyISAM COMMENT='Simplemail - Simplemail log'
}) or die $dbh->errstr;
$dbh->do(qq{
CREATE TABLE IF NOT EXISTS maillog (
id INT(11) NOT NULL AUTO_INCREMENT,
data VARCHAR(30) NOT NULL,
text text NOT NULL,
KEY id (id)
) TYPE=MyISAM COMMENT='Simplemail - Maillog'
}) or die $dbh->errstr;
$dbh->do(qq{
CREATE TABLE IF NOT EXISTS mailbox_delete (
domain varchar(255) NOT NULL default '',
mailbox varchar(255) NOT NULL default '',
created datetime NOT NULL default '0000-00-00 00:00:00',
KEY mailbox (mailbox)
) TYPE=MyISAM COMMENT='Simplemail - Malbox Delete'
}) or die $dbh->errstr;
$dbh->do(qq{
CREATE TABLE IF NOT EXISTS domain_delete (
domain varchar(255) NOT NULL default '',
created datetime NOT NULL default '0000-00-00 00:00:00',
KEY domain (domain)
) TYPE=MyISAM COMMENT='Simplemail - Domain Delete'
}) or die $dbh->errstr;
$dbh->do(qq{
CREATE TABLE IF NOT EXISTS users (
id INT(11) NOT NULL AUTO_INCREMENT,
name VARCHAR(100) NOT NULL,
pass VARCHAR(100) NOT NULL,
info tinyint(1) NOT NULL,
created datetime NOT NULL,
active tinyint(1) NOT NULL,
PRIMARY KEY (id)
) TYPE=MyISAM COMMENT='Simplemail - Users'
}) or die $dbh->errstr;
$dbh->do(qq{
CREATE TABLE IF NOT EXISTS session (
session CHAR(32) NOT NULL,
user INT(11) NOT NULL,
time INT(11) NOT NULL,
host VARCHAR(100) NOT NULL,
ip VARCHAR(100) NOT NULL,
forwarded VARCHAR(100) NOT NULL,
PRIMARY KEY (session)
) TYPE=MyISAM COMMENT='Simplemail - Session'
}) or die $dbh->errstr;
$dbh->do(qq{INSERT INTO users SET id = ?, name = ?, pass = ?},
undef, '4', 'Guest','nopassword');
$dbh->do(qq{INSERT INTO users SET id = ?, name = ?, pass = ?},
undef, '5', 'Admin', $pass_admin);
print 'ok';
0;
| вот пример одного модуля:
package editadmin;
use base 'func'; # класс с которого будет наследовать
use Data::Validate::Domain qw(is_domain);
use Data::Validate::Email qw(is_email);
use strict;
use CGI::Carp qw(fatalsToBrowser);
# наследуем конструктор
sub new {
my $self = shift->SUPER::new(@_);
$self->dbi_connect if $self->can("dbi_connect");
return $self;
}
sub return_edit_admin {
my $self = shift;
my $dd;
my $sth = $self->{dbh}->prepare(
'SELECT t1.id,
t1.name,
t1.info,
t1.active,
t1.created,
t2.m_mailbox,
t2.m_domain,
t2.m_alias,
t2.mb_domain,
t2.mb_mailbox
FROM users AS t1
LEFT JOIN admin_domain AS t2
ON t1.id = t2.idname
WHERE t1.id = ?
LIMIT 1
'
);
$sth->execute( $self->{p}->{username} );
# результат ссылка на хэш
$dd = $sth->fetchrow_hashref();
$sth->finish();
my $sth = $self->{dbh}->prepare(
'SELECT domain
FROM domain
WHERE idnane = ?
ORDER by domain asc'
);
$sth->execute( $self->{p}->{username} );
my $rows2;
# массив хэшей
push @{$rows2}, $_ while $_ = $sth->fetchrow_hashref();
$sth->finish();
my $sth = $self->{dbh}->prepare(
'SELECT domain
FROM domain
ORDER by domain asc'
);
$sth->execute();
my $rows;
# массив хэшей
push @{$rows}, $_ while $_ = $sth->fetchrow_hashref();
$sth->finish();
# $self->{he} - это хэш который идет в шаблон,
# короче говоря: значения с параметрами
if ( !$rows ) {
$self->{he}->{NO_DOMAIN} = 1;
}
else {
$self->{he}->{ROWS} = $rows;
}
if ( !$rows2 ) {
$self->{he}->{NO_DOMAIN2} = 1;
}
else {
$self->{he}->{ROWS2} = $rows2;
}
if ( $dd->{m_alias} > 0 || $dd->{m_alias} == 0 ) {
$dd->{createalias_too} = 1;
}
else {
$dd->{createalias_too} = undef;
}
# округление
$dd->{mb_domain} = sprintf( '%.f', $dd->{mb_domain} / 1048576 )
if ( $dd->{mb_domain} > 0 );
$dd->{mb_mailbox} = sprintf( '%.f', $dd->{mb_mailbox} / 1048576 )
if ( $dd->{mb_mailbox} > 0 );
$dd->{createdomain_too} = 1 if ( $dd->{m_domain} ne '' );
$dd->{m_alias} = '' if ( $dd->{m_alias} == -1 );
# $self->{he} - это хэш который идет в шаблон, то есть значения с парамертами
# заносим данные в него с $dd
while ( my ( $key, $value ) = each( %{$dd} ) ) {
$self->{he}->{$key} = $value;
}
return $self;
}
# наследуем метод который передает с $self->{he} в шаблон и выводит его
sub templ_hash_admin {
my $self = shift;
$self->{session}->{filet} = 'edit-admin';
# это обозначние какой файл шаблона выводить
$self->SUPER::templ_hash(@_);
return $self;
}
# Уничтожает объект, освобождает память
sub DESTROY {
my $self = shift;
$self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
}
1;
| и еще одного:
package delete2;
use strict;
use CGI::Carp qw(fatalsToBrowser);
use base 'func'; # класс с которого будет наследовать
# наследуем конструктор
sub new {
my $self = shift->SUPER::new(@_);
$self->dbi_connect if $self->can("dbi_connect");
return $self;
}
# приватный метод, замкнутный, который работает как функция
sub _referer {
my $self = shift;
# строиться url из массивов для редиректа, на то место где мы находимся
my @url = ();
$self->{se}->{url_real} = '?action=postfix&postfixactive=';
push @url, $self->{se}->{url};
push @url, $self->{se}->{url_real};
push @url, $self->{se}->{url_active}; # method2
if ( $self->{p}->{domain} ) {
push @url, '&fDomain=' . $self->{p}->{domain};
}
if ( $self->{p}->{domain2} ) {
push @url, '&domain=' . $self->{p}->{domain2};
}
if ( $self->{p}->{username} && $self->{session}->{name} eq 'Admin' ) {
push @url, '&username=' . $self->{'p'}->{username};
}
if ( $self->{p}->{from} ) {
push @url, '&from=' . $self->{p}->{from};
}
my $referer = join( '', @url );
print $self->{query}->redirect( -uri => $referer, -status => 301 );
# редиректим
#return $self;
}
sub edit_admin_active {
my $self = shift;
$self->{session}->{filet} = 'editeadminactive';
$self->insert_logsmail if $self->can("insert_logsmail");
my $sth = $self->{dbh}->prepare(
'UPDATE users
SET active=1-active
WHERE id = ?
'
);
$sth->execute( $self->{p}->{username} );
$sth->finish();
$self->{p}->{domain} = undef;
$self->{p}->{username} = undef;
$self->{se}->{url_active} = 'listadmin';
return $self->_referer();
}
sub edit_domain_active {
my $self = shift;
$self->{session}->{filet} = 'editedomainactive';
$self->insert_logsmail if $self->can("insert_logsmail");
my @sql = ();
my @sqlb = ();
my $clause;
if ( $self->{session}->{name} ne 'Admin' ) {
push @sql, $self->{p}->{domain}, $self->{session}->{user};
push @sqlb, "AND idnane = ?"; # это программное построение запросов
}
else {
push @sql, $self->{p}->{domain}; # это программное построение запросов
}
$clause = join( '', @sqlb ); # собственно часть запроса
my $sth = $self->{dbh}->prepare(
"UPDATE domain
SET active=1-active
WHERE domain = ?
$clause
"
);
$sth->execute(@sql);
$sth->finish();
$self->{p}->{domain} = undef;
$self->{se}->{url_active} = 'listdomain';
return $self->_referer();
}
sub edite_mail_active {
my $self = shift;
$self->{session}->{filet} = 'editemailactive';
$self->insert_logsmail if $self->can("insert_logsmail");
my @sql = ();
my @sqlb = ();
my $clause;
if ( $self->{session}->{name} ne 'Admin' ) {
push @sql, $self->{p}->{mailbox}, $self->{p}->{domain},
$self->{session}->{user};
push @sqlb, "AND t2.idnane = ?";
$clause = join( '', @sqlb );
}
else {
push @sql, $self->{p}->{mailbox}, $self->{p}->{domain};
}
my $sth = $self->{dbh}->prepare(
"UPDATE mailbox
AS t1, domain AS t2
SET t1.active=1-t1.active
WHERE t1.username= ?
AND t1.domain = ?
$clause
"
);
$sth->execute(@sql);
$sth->finish();
$self->{p}->{domain2} = $self->{p}->{domain};
$self->{p}->{domain} = undef;
$self->{se}->{url_active} = 'listvirtual';
return $self->_referer();
}
sub delete_alias {
my $self = shift;
$self->{session}->{filet} = 'deletealias';
$self->insert_logsmail if $self->can("insert_logsmail");
my @sql = ();
my $clause;
my $dd;
if ( $self->{session}->{name} ne 'Admin' ) {
my $sth = $self->{dbh}->prepare(
'SELECT t1.domain,
t1.idnane,
t1.aliases,
t2.address
FROM domain AS t1,
alias AS t2
WHERE t1.domain = ?
AND t1.idnane = ?
AND t2.address = ?
AND t1.domain = t2.domain
LIMIT 1
'
);
$sth->execute(
$self->{p}->{domain},
$self->{session}->{user},
$self->{p}->{address}
);
$dd = $sth->fetchrow_hashref();
$sth->finish();
push @sql, $dd->{domain}, $dd->{address};
}
else {
push @sql, $self->{p}->{domain}, $self->{p}->{address};
}
if ( $dd->{aliases} ne '-1' ) {
$self->{dbh}->do(
qq{DELETE FROM alias
WHERE domain = ?
AND address = ?},
undef, @sql
);
}
$self->{se}->{url_active} = 'listvirtual';
$self->{p}->{domain2} = $self->{p}->{domain};
$self->{p}->{domain} = undef;
return $self->_referer();
}
sub delete_domain {
my $self = shift;
$self->{session}->{filet} = 'deletedomain';
$self->insert_logsmail if $self->can("insert_logsmail");
my $dd;
my @sql = ();
my $clause;
if ( $self->{session}->{name} ne 'Admin' ) {
push @sql, $self->{p}->{domain}, $self->{session}->{user};
$clause = 'domain = ? AND idnane = ?';
}
else {
push @sql, $self->{p}->{domain};
$clause = 'domain = ?';
}
my $sth = $self->{dbh}->prepare(
"SELECT domain
FROM domain
WHERE $clause
LIMIT 1
"
);
$sth->execute(@sql);
$dd = $sth->fetchrow_hashref();
$sth->finish();
my $sth = $self->{dbh}->prepare(
'SELECT username,
domain
FROM mailbox
WHERE domain = ?
'
);
$sth->execute( $dd->{domain} );
# выводятся значение в массиве со ссылками на него и на значения
my $mailbox_del = $sth->fetchall_arrayref();
$sth->finish();
# выводим эти значение от нуля ... и до окнца массива
foreach $_ ( 0 .. $#{$mailbox_del} ) {
$self->{dbh}->do(
qq{INSERT INTO mailbox_delete
(domain, mailbox,created)
VALUES (?,?,NOW())},
undef, $dd->{domain}, $mailbox_del->[$_]->[0]
# [$_]->[0] - это означает первый столбец, он один
);
}
$self->{dbh}->do(
qq{INSERT INTO domain_delete
(domain,created)
VALUES (?,NOW())},
undef, $dd->{domain}
);
$self->{dbh}->do(
qq{DELETE FROM mailbox
WHERE domain = ?},
undef, $dd->{domain}
);
$self->{dbh}->do(
qq{DELETE FROM alias
WHERE domain = ?},
undef, $dd->{domain}
);
$self->{dbh}->do(
qq{DELETE FROM domain
WHERE domain = ? },
undef, $dd->{domain}
);
$self->{se}->{url_active} = 'listdomain';
return $self->_referer();
# вызываем приватный метод, можно было сделать анонимную подпрограмму
}
sub delete_mailbox {
my $self = shift;
$self->{session}->{filet} = 'deletemailbox';
$self->insert_logsmail if $self->can("insert_logsmail");
my @sql = ();
my $clause;
if ( $self->{session}->{name} ne 'Admin' ) {
push @sql, $self->{p}->{domain}, $self->{p}->{delete},
$self->{session}->{user};
$clause = 't2.domain = ? AND t2.username = ? AND t1.idnane =?';
}
else {
push @sql, $self->{p}->{domain}, $self->{p}->{delete};
$clause = 't2.domain = ? AND t2.username = ?';
}
my $sth = $self->{dbh}->prepare(
"SELECT t1.created,
t2.domain,
t2.username
FROM domain AS t1,
mailbox AS t2
WHERE $clause
LIMIT 1
"
);
$sth->execute(@sql);
my $dd = $sth->fetchrow_hashref();
$sth->finish();
if ( defined( $dd->{username} ) ) {
$self->{dbh}->do(
qq{INSERT INTO mailbox_delete
(domain, mailbox, created)
VALUES (?,?,NOW())},
undef, $dd->{domain}, $dd->{username}
);
$self->{dbh}->do(
qq{DELETE FROM mailbox
WHERE username = ?},
undef, $dd->{username}
);
$self->{dbh}->do(
qq{DELETE FROM alias
WHERE address = ?},
undef, $dd->{username}
);
}
$self->{p}->{domain2} = $self->{p}->{domain};
$self->{p}->{domain} = undef;
$self->{se}->{url_active} = 'listvirtual';
return $self->_referer();
}
sub delete_admin {
my $self = shift;
$self->{session}->{filet} = 'deleteadmin';
$self->insert_logsmail if $self->can("insert_logsmail");
my $sth = $self->{dbh}->prepare(
'SELECT domain
FROM domain
WHERE idnane = ?
'
);
$sth->execute( $self->{p}->{admin} );
# выводятся значение в массиве со ссылками на него и на значения
my $domain_del = $sth->fetchall_arrayref();
$sth->finish();
my $mailbox_del;
# выводим эти значение от нуля ... и до окнца массива
foreach $_ ( 0 .. $#{$domain_del} ) {
my $sth = $self->{dbh}->prepare(
'SELECT username,
domain
FROM mailbox
WHERE domain = ?
'
);
$sth->execute( $domain_del->[$_]->[0] );
# [$_]->[0] это означает первый столбец, он один
push @{$mailbox_del}, $_ while $_ = $sth->fetchrow_hashref();
$sth->finish();
}
foreach $_ ( @{$mailbox_del} ) {
$self->{dbh}->do(
qq{INSERT INTO mailbox_delete
(domain, mailbox,created)
VALUES (?,?,NOW())},
undef, $_->{domain}, $_->{username}
);
}
# выводим эти значение от нуля ... и до окнца массива
foreach $_ ( 0 .. $#{$domain_del} ) {
$self->{dbh}->do( qq{DELETE FROM mailbox WHERE domain = ?},
undef, $domain_del->[$_]->[0] );
}
foreach $_ ( 0 .. $#{$domain_del} ) {
$self->{dbh}->do(
qq{INSERT INTO domain_delete (domain,created)
VALUES (?,NOW())}, undef, $domain_del->[$_]->[0]
# [$_]->[0] это означает первый столбец, он один
);
}
foreach $_ ( 0 .. $#{$domain_del} ) {
$self->{dbh}->do( qq{DELETE FROM domain WHERE domain = ?},
undef, $domain_del->[$_]->[0] );
}
foreach $_ ( 0 .. $#{$domain_del} ) {
$self->{dbh}->do( qq{DELETE FROM alias WHERE domain = ?},
undef, $domain_del->[$_]->[0] );
}
$self->{dbh}->do( qq{DELETE FROM admin_domain WHERE idname = ?},
undef, $self->{p}->{admin} );
$self->{dbh}
->do( qq{DELETE FROM users WHERE id = ?}, undef, $self->{p}->{admin} );
$self->{p}->{username} = undef;
$self->{p}->{domain} = undef;
$self->{se}->{url_active} = 'listadmin';
return $self->_referer();
}
# Уничтожает объект, освобождает память
sub DESTROY {
my $self = shift;
$self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
}
1;
|
другая реализация:
блокировка спама (captcha, whitelist, blacklist, greylist для ящика)
ЗЫ сделать инсталятор можно было, но очень долго, так вроде бы нормально...
ЗЫЫ можно использовать другую СУБД, только таблицу создать по другому или поменять и посмотреть еще что-то нужно если не зарабатывает, или запросы подправить под абстракцию DBIx::Class, Class::DBI или SQL::Abstract
Если не зарабатывает, то спрашивайте, все другие вопросы, развитие существующих и дополнительных возможностей, etc. также написание других программ...
Демо тут:
http://unixforum.org.ua/index.php?topic=17604
Ссылка на обсуждение: http://forum.lissyara.su/viewtopic.php?f=14&p=131693.
|
размещено: 2009-01-17,
последнее обновление: 2010-05-15,
автор: ProFTP
|
|
|
|
2014-07-27, lissyara
gmirror
Удалённое создание софтверного зеркала средствами gmirror, на диске разбитом с использованием gpart. Использование меток дисков для монтирования разделов.
2013-08-20, zentarim
Scan+Print server FreeBSD 9
Настройка сервера печати и сервера сканирования под управлением операционной системы FreebSD 9 для МФУ Canon PIXMA MP540
2011-11-20, BlackCat
Разъём на WiFi-карту
Делаем съёмной несъёмную антену на WiFi-карте путём установки ВЧ-разъёма
2011-09-14, manefesto
Настройка git+gitosis
Настройка системы контроля версия исходного кода в связке git+gitosis+ssh
|
Комментарии пользователей [3 шт.]