Мы — долго запрягаем, быстро ездим, и сильно тормозим.
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 или через консоль :

  $ 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`;

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


  $./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

     $ 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;







другая реализация:
блокировка спама (captcha, whitelist, blacklist, greylist для ящика)

ЗЫ сделать инсталятор можно было, но очень долго, так вроде бы нормально...
ЗЫЫ можно использовать другую СУБД, только таблицу создать по другому или поменять и посмотреть еще что-то нужно если не зарабатывает, или запросы подправить под абстракцию DBIx::Class, Class::DBI или SQL::Abstract

Если не зарабатывает, то спрашивайте, все другие вопросы, развитие существующих и дополнительных возможностей, etc. также написание других программ...

Демо тут:
http://unixforum.org.ua/index.php?topic=17604



размещено: 2009-01-17,
последнее обновление: 2010-05-15,
автор: ProFTP


Комментарии пользователей [3 шт.]

Burzum, 2010-11-16 в 18:37:45

Ссылки:
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
не рабочие...

нет такой директории и файла....

ProFTP, 2010-11-17 в 11:40:58

ftp не работает видимо...
я постараюсь найти и закачать куда-то исходники, они есть в любом случае у меня.
заодно спрошу у админка когда ftp будет работаеть
====
а можно узнать что вы хотите сделать? просто посмотреть или использовать для каких-то целей?
просто, многие просят что-то, а потом отказываются :)

ProFTP, 2010-12-15 в 15:47:42

уже доступано!
 

  Этот информационный блок появился по той простой причине, что многие считают нормальным, брать чужую информацию не уведомляя автора (что не так страшно), и не оставляя линк на оригинал и автора — что более существенно. Я не против распространения информации — только за. Только условие простое — извольте подписывать автора, и оставлять линк на оригинальную страницу в виде прямой, активной, нескриптовой, незакрытой от индексирования, и не запрещенной для следования роботов ссылки.
  Если соизволите поставить автора в известность — то вообще почёт вам и уважение.

© lissyara 2006-10-24 08:47 MSK

Время генерации страницы 0.1031 секунд
Из них PHP: 71%; SQL: 29%; Число SQL-запросов: 80 шт.
У Вас отключено GZIP-сжатие в браузере. Размер страницы 93362