Ключевые слова:mail, postfix, freebsd, (найти похожие документы)
From: ProFTP <q7u5@ukr.net.>
Newsgroups: email
Date: Mon, 15 Jul 2009 14:31:37 +0000 (UTC)
Subject: Установка Simplemail Admin (аналог PostfixAdmin)
Программа для администрирования виртуальных доменов в 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
(или /usr/ports/databases/p5-DBD-mysql51/)
сd /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
Про настройку виртуальных доменов можно посмотреть здесь:
(таблицы 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>
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.gzftp://ftp.lissyara.su/users/ProFTP/simplemailadmin-1.0.zipftp://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[/code]
права на исполняемый файл:
$ 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 или через консоль :
$ mysql -u root -p
> 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`;[/code]
4. Конфигурация
(если путь к конфигу не такой /usr/local/www/simplemail/lib/config.pl
то нужно в файле maillog.pl откоректирвоать путь к нему
ee maillog.pl
require "/home/...../simplemail/lib/config.pl";
файл с настройками /lib/config.pl
нужно написать имя пользвотеля, базу, пароль к MySQl и т.д.
5. Инсталяция таблиц и пароль админа.
$ chmod 750 install.pl[/code]
$./install.pl passwd_admin[/code]
первый аргумент 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[/code]
7. Delete install.pl
$ rm 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;
PS. сделать инсталятор можно было, но очень долго, так вроде бы нормально...
PPS. можно использовать другую СУБД, только таблицу создать по другому
или поменять и посмотреть еще что-то нужно если не зарабатывает, или
запросы подправить под абстракцию DBIx::Class, Class::DBI или
SQL::Abstract
Если не зарабатывает, то спрашивайте, все другие вопросы, развитие
существующих и дополнительных возможностей, etc.
Демо тут: http://unixforum.org.ua/index.php?topic=17604
Автор: ProFTP
