smeserver-ddclient/root/etc/e-smith/web/functions/ddclient

1417 lines
41 KiB
Perl
Executable File

#!/usr/bin/perl -wT
#----------------------------------------------------------------------
# heading : Configuration
# description : ddclient
# navigation : 3000 3400
#----------------------------------------------------------------------
#----------------------------------------------------------------------
# copyright (C) 2002 Mitel Networks Corporation
#
# 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 of the License, 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 should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# Technical support for this program is available from Mitel Networks
# Please visit our web site www.mitel.com/sme/ for details.
#----------------------------------------------------------------------
#package esmith;
use strict;
use CGI ':all';
use CGI::Carp qw(fatalsToBrowser);
use esmith::FormMagick;
my $fm = esmith::FormMagick->new();
$fm->parse_xml();
use esmith::cgi;
use esmith::util;
use esmith::ConfigDB;
use esmith::AccountsDB;
sub showInitial ($$);
sub genContentMenu ($$);
sub createDomain ($);
sub performCreateDomain ($);
sub modifyDomain ($);
sub performModifyDomain ($);
sub deleteDomain ($);
sub performDeleteDomain ($);
sub ddcreateDomain ($);
sub ddperformCreateDomain ($);
sub ddmodifyDomain ($);
sub ddperformModifyDomain ($);
sub dddeleteDomain ($);
sub ddperformDeleteDomain ($);
sub genServer ($$);
sub genRetrieve($$);
sub genRetrieveMethod($$);
sub performRetrieve($);
#######################################################################
BEGIN
{
# Clear PATH and related environment variables so that calls to
# external programs do not cause results to be tainted. See
# "perlsec" manual page for details.
$ENV {'PATH'} = '';
$ENV {'SHELL'} = '/bin/bash';
delete $ENV {'ENV'};
}
esmith::util::setRealToEffective ();
$CGI::POST_MAX=1024 * 100; # max 100K posts
$CGI::DISABLE_UPLOADS = 1; # no uploads
my $conf = esmith::ConfigDB->open() or die "Unable to open configuration db";
tie my %conf, 'esmith::config', '/home/e-smith/db/configuration';
if ( ! %conf) {
tie %conf, 'esmith::config', '/home/e-smith/configuration';
}
my $domaindb = esmith::ConfigDB->open('/home/e-smith/db/domains')
or die "Unable to open domains db";
my $edb;
$edb = esmith::ConfigDB->open('/home/e-smith/db/ddclient')
or $edb = esmith::ConfigDB->create('/home/e-smith/db/ddclient');
#------------------------------------------------------------
# examine state parameter and display the appropriate form
#------------------------------------------------------------
my $q = new CGI;
if (! grep (/^state$/, $q->param))
{
showInitial ($q, '');
}
elsif ($q->param ('state') eq "create")
{
createDomain ($q);
}
elsif ($q->param ('state') eq "performCreate")
{
performCreateDomain ($q);
}
elsif ($q->param ('state') eq "modify")
{
modifyDomain ($q);
}
elsif ($q->param ('state') eq "performModify")
{
performModifyDomain ($q);
}
elsif ($q->param ('state') eq "delete")
{
deleteDomain ($q);
}
elsif ($q->param ('state') eq "performDelete")
{
performDeleteDomain ($q);
}
elsif ($q->param ('state') eq "ddcreate") {
ddcreateDomain ($q);
}
elsif ($q->param ('state') eq "ddperformCreate") {
ddperformCreateDomain ($q);
}
elsif ($q->param ('state') eq "ddmodify") {
ddmodifyDomain ($q);
}
elsif ($q->param ('state') eq "ddperformModify") {
ddperformModifyDomain ($q);
}
elsif ($q->param ('state') eq "dddelete") {
dddeleteDomain ($q);
}
elsif ($q->param ('state') eq "ddperformDelete") {
ddperformDeleteDomain ($q);
}
elsif ($q->param ('state') eq "performRetrieve") {
performRetrieve($q);
}
else
{
esmith::cgi::genStateError ($q, \%conf);
}
exit (0);
#------------------------------------------------------------
# subroutine to display initial form
#------------------------------------------------------------
sub get_dns_labels {
#
# dns service names from ddclient
#
# Better here would be to extract this list from the ddclient package.
my $Labels = (
[
'CUSTOMDNS' ,
'DYNDNS1' ,
'DYNDNS2' ,
'DYNDNS3' ,
'ZONEDIT' ,
'EASYDNS' ,
'HAMMER' ,
'DSLREPORTS' ,
'EURODYNDNS' ,
'DTDNS' ,
'LOOPIA' ,
'DNSPARK' ,
'DYNHOST' ,
'NOIP' ,
'CHANGEIP' ,
'NAMECHEAP' ,
'SPDNS' ,
'SITELUTIONS',
'FREEDNS',
'NSUPDATE',
'CLOUDFLARE',
'GOOGLEDOMAINS',
'DUCKDNS',
'FREEMYIP',
'WOIMA',
'YANDEX',
'DNSMADEEASY',
'DONDOMINIO',
'NFSN',
'OVH',
'CLOUDNS'
]
);
return $Labels;
}
sub genServer ($$)
{
my ($q, $curSetting) = @_;
if ((! defined $curSetting) || ($curSetting eq ''))
{
$curSetting = 'dyndns1';
}
my $Labels = get_dns_labels();
# Create translated description for them
my %LabelDescriptions;
foreach my $lab (@$Labels){
$LabelDescriptions{$lab}= $fm->localise($lab);
};
return esmith::cgi::genCell ($q, $q->popup_menu (-name => 'dns',
-values => $Labels,
-default => $curSetting,
-labels => \%LabelDescriptions));
}
#------------------------------------------------------------
sub genRetrieve($$) {
my ($q, $curSetting) = @_;
if ((! defined $curSetting) || ($curSetting eq ''))
{
$curSetting = 'yes';
}
my %Labels = (
'yes' => $fm->localise('yes'),
'no' => $fm->localise('no'),
);
return esmith::cgi::genCell ($q, $q->popup_menu (-name => 'retrievessl',
-values => [
'yes','no'
],
-default => $curSetting,
-labels => \%Labels));
}
#------------------------------------------------------------
sub genRetrieveMethod($$) {
my ($q, $curSetting) = @_;
if ((! defined $curSetting) || ($curSetting eq ''))
{
$curSetting = 'web';
}
my %Labels = (
'smeIF' => $fm->localise('SME external interface'),
'smeCMD' => $fm->localise('SME configuration DB'),
'web' => $fm->localise('web'),
'if' => $fm->localise('Interface'),
'ip' => $fm->localise('IP'),
'cmd' => $fm->localise('Command'),
);
return esmith::cgi::genCell ($q, $q->popup_menu (-name => 'retrievemethod',
-values => [
'smeIF','smeCMD','web','if','ip','cmd'
],
-default => $curSetting,
-labels => \%Labels));
}
#------------------------------------------------------------
#
sub showInitial ($$)
{
my ($q, $msg) = @_;
#------------------------------------------------------------
# If there's a message, we just finished an operation so show the
# status report. If no message, this is a new list of domains.
#------------------------------------------------------------
if ($msg eq '')
{
esmith::cgi::genHeaderNonCacheable ($q, \%conf, $fm->localise('FORM_TITLE'));
}
else
{
esmith::cgi::genHeaderNonCacheable ($q, \%conf, $fm->localise('OPERATION_STATUS_REPORT'));
print $q->p ($msg);
print $q->hr;
}
print $q->p ($fm->localise('FORM_DESCRIPTION'));
#------------------------------------------------------------
# get the ip retrieve method
#------------------------------------------------------------
my $ddretrieve=$conf->get('ddclient');
my $ExtIF=$conf->get('ExternalInterface');
my $DeamonUpdate=$ddretrieve->prop('DeamonUpdate')|| '300';
my $urlcheckip=$ddretrieve->prop('urlcheckip')|| 'checkip.dyndns.org';
my $ssl=$ddretrieve->prop('SSL')|| 'yes';
my $method=$ddretrieve->prop('method')||'web';
my $Extinterface=$ddretrieve->prop('Extinterface')||'';
my $cmd=$ddretrieve->prop('cmd')||'';
my $forceIP=$ddretrieve->prop('ForceIP')||'';
print $q->startform (-method => 'POST',
-action => $q->url (-absolute => 1));
print $q->table ({border => 0, cellspacing => 0, cellpadding => 4},
$q->Tr (esmith::cgi::genCell($q,
$fm->localise('RETRIEVE_SSL').":", 'sme-noborders-label' ),
genRetrieve($q,$ssl)),
# esmith::cgi::genWidgetRow ($q, $fm->localise('RETRIEVE_SSL')),
# $q->popup_menu (-name => 'SSL',
# -values => ['yes', 'no'],
# -default => $ssl),
# -labels => \%status)) ,
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('RETRIEVE_DEAMONUPDATE'),
"retrievedeamonupdate",$DeamonUpdate)),
$q->Tr (esmith::cgi::genCell ($q,$fm->localise('RETRIEVE_METHOD').":", 'sme-noborders-label' ),
genRetrieveMethod($q,$method)),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('RETRIEVE_IF'),
"retrieveinterface",$Extinterface)),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('RETRIEVE_CMD'),
"retrievecmd",$cmd)),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('RETRIEVE_IP'),
"retrieveip",$forceIP)),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('RETRIEVE_URLCHECKIP'),
"retrieveurlcheckip",$urlcheckip)),
esmith::cgi::genButtonRow ( $q,
$q->submit (-name => 'action',
-value => $fm->localise('APPLY')))
);
print $q->hidden (-name => 'state',
-override => 1,
-default => 'performRetrieve');
print $q->endform;
print $q->hr;
#------------------------------------------------------------
# Look up domains and domain descriptions
#------------------------------------------------------------
my $key;
my @virtualDomains = ();
foreach my $domain ($domaindb->get_all_by_prop(type=>'domain'))
{
$key = $domain->key;
push (@virtualDomains, $key);
}
print $q->p ($fm->localise('FORM_DESCRIPTION'));
my $numDomains = @virtualDomains;
if ($numDomains == 0)
{
print $q->p ($q->b ($fm->localise('NO_VIRTUAL_DOMAINS')));
}
else
{
print $q->p ($q->b ($fm->localise('CURRENT_LIST_OF_DOMAINS')));
print $q->table ({border => 1, cellspacing => 1, cellpadding => 4});
print $q->Tr (esmith::cgi::genSmallCell ($q, $q->b ($fm->localise('DOMAIN'))),
esmith::cgi::genSmallCell ($q, $q->b ($fm->localise('DESCRIPTION'))),
esmith::cgi::genSmallCell ($q, $q->b ($fm->localise('CONTENT', ))),
esmith::cgi::genSmallCell ($q, $q->b ($fm->localise('PUBLICATION', ))),
$q->td (' '),
$q->td (' '));
my $domain;
foreach $domain (sort @virtualDomains)
{
my %properties = $domaindb->get($domain)->props;
my $test=$domaindb->get($domain) || '';
my %extraprops;
if($test ne '')
{
%extraprops = $domaindb->get($domain)->props;
}
my $content;
if ($properties{'Content'} eq 'wwwpublic')
{
$content = $fm->localise('PRIMARY_SITE');
}
else
{
$content = $fm->localise('CONTENT',
{content => $properties{'Content'}});
}
my $public;
if ($test eq '')
{
print $q->Tr (esmith::cgi::genSmallCell ($q, $domain),
esmith::cgi::genSmallCell ($q, $properties{'Description'}),
esmith::cgi::genSmallCell ($q, $content),
esmith::cgi::genSmallCell ($q, '&nbsp'),
esmith::cgi::genSmallCell ($q, '&nbsp'),
esmith::cgi::genSmallCell ($q,
$q->a ({href => $q->url (-absolute => 1)
. "?state=create&domain="
. $domain}, $fm->localise('CREATE', ))),
esmith::cgi::genSmallCell ($q, '&nbsp')
);
}
else
{
print $q->Tr (esmith::cgi::genSmallCell ($q, $domain),
esmith::cgi::genSmallCell ($q, $properties{'Description'}),
esmith::cgi::genSmallCell ($q, $content),
esmith::cgi::genSmallCell ($q, $fm->localise($extraprops{'dns'})),
esmith::cgi::genSmallCell ($q,
$q->a ({href => $q->url (-absolute => 1)
. "?state=modify&domain="
. $domain}, $fm->localise('MODIFY', ))),
esmith::cgi::genSmallCell ($q,
$q->a ({href => $q->url (-absolute => 1)
. "?state=delete&domain="
. $domain}, $fm->localise('DELETE', )))
);
}
}
print '</table>';
}
print $q->hr;
#########################################################################################################################################
# now the free form part
#
my @FreeDomains = ();
foreach my $domain ($edb->get_all_by_prop(type=>'ddhost'))
{
my $key = $domain->key;
push (@FreeDomains, $key);
}
print $q->p ($fm->localise('FREE_FORM_DESCRIPTION'));
$numDomains = @FreeDomains;
print $q->p ($q->b ($fm->localise('CURRENT_LIST_OF_DOMAINS')));
print $q->table ({border => 1, cellspacing => 1, cellpadding => 4});
print $q->Tr (esmith::cgi::genSmallCell ($q, $q->b ($fm->localise('DOMAIN'))),
esmith::cgi::genSmallCell ($q, $q->b ($fm->localise('DESCRIPTION'))),
esmith::cgi::genSmallCell ($q, $q->b ($fm->localise('PUBLICATION'))),
$q->td ('&nbsp;'),
$q->td ('&nbsp;')
);
if ( $numDomains > 0 ) {
foreach my $domain (sort @FreeDomains) {
my $vals = $edb->get($domain);
my $content = $vals->prop('desc');
my $publish = $fm->localise($vals->prop('dns'));
print $q->Tr (esmith::cgi::genSmallCell ($q, $domain),
esmith::cgi::genSmallCell ($q, $content),
esmith::cgi::genSmallCell ($q, $publish),
esmith::cgi::genSmallCell ($q,
$q->a ({href => $q->url (-absolute => 1)
. "?state=ddmodify&domain="
. $domain}, $fm->localise('MODIFY', ))),
esmith::cgi::genSmallCell ($q,
$q->a ({href => $q->url (-absolute => 1)
. "?state=dddelete&domain="
. $domain}, $fm->localise('DELETE', )))
);
}
}
print $q->Tr (($q->td('&nbsp;')),
($q->td('&nbsp;')),
($q->td('&nbsp;')),
($q->td('&nbsp;')),
esmith::cgi::genSmallCell ($q,
$q->a ({href => $q->url (-absolute => 1)
. "?state=ddcreate"}, $fm->localise('CREATE', )))
);
print '</table>';
esmith::cgi::genFooter ($q);
}
#------------------------------------------------------------
#
#------------------------------------------------------------
sub genContentMenu ($$)
{
my ($q, $currentSetting) = @_;
if ((! defined $currentSetting) || ($currentSetting eq ''))
{
$currentSetting = 'wwwpublic'; # this chooses the primary web site
}
my $acctdb = esmith::AccountsDB->open();
my %labels = ();
my @values = ();
foreach my $ibay ($acctdb->get_all_by_prop(type=>'ibay'))
{
my $key = $ibay->key;
my %properties = $ibay->props;
$labels {$key} = $properties {'Name'};
}
@values = sort (keys %labels);
$labels {'wwwpublic'} = $fm->localise('PRIMARY_SITE');
unshift @values, 'wwwpublic';
return esmith::cgi::genCell ($q, $q->popup_menu (-name => 'domainContent',
-values => \@values,
-default => $currentSetting,
-labels => \%labels));
}
#------------------------------------------------------------
#
#------------------------------------------------------------
sub performRetrieve($) {
my ($q) = @_;
my $deamonupdate =$q->param('retrievedeamonupdate');
my $urlcheckip =$q->param('retrieveurlcheckip');
my $ssl = $q->param('retrievessl');
my $retrievemethod = $q->param('retrievemethod');
my $retrieveinterface = $q->param('retrieveinterface');
my $retrievecmd = $q->param('retrievecmd');
my $retrieveip = $q->param('retrieveip');
my $ddclient=$conf->get('ddclient');
$ddclient->set_prop('urlcheckip' => $urlcheckip);
$ddclient->set_prop('DeamonUpdate' => $deamonupdate);
$ddclient->set_prop('SSL' => $ssl);
$ddclient->set_prop('method' => $retrievemethod);
$ddclient->set_prop('Extinterface' => $retrieveinterface );
$ddclient->set_prop('cmd' => $retrievecmd);
$ddclient->set_prop('ForceIP' => $retrieveip);
$domaindb->reload();
system ("/sbin/e-smith/signal-event", "smeserver-ddclient-update");
showInitial ($q, $fm->localise('SUCCESSFULLY_MODIFIED_RETRIEVE_IP'));
}
#------------------------------------------------------------
sub createDomain ($)
{
my ($q) = @_;
my $domain=$q->param('domain');
esmith::cgi::genHeaderNonCacheable
($q, \%conf, $fm->localise('CREATE_TITLE'));
my %properties = $domaindb->get($domain)->props;
my $test=$domaindb->get($domain) || '';
my %extraprops;
if($test ne '')
{
%extraprops = $domaindb->get($domain)->props;
}
my $content;
if ($properties{'Content'} eq 'wwwpublic')
{
$content = $fm->localise('PRIMARY_SITE');
}
else
{
$content = $fm->localise('CONTENT',
{content => $properties{'Content'}});
}
print $q->startform (-method => 'POST',
-action => $q->url (-absolute => 1));
print $q->table ({border => 0, cellspacing => 0, cellpadding => 4},
$q->Tr (esmith::cgi::genCell ($q,$fm->localise('DOMAIN_NAME')),
esmith::cgi::genCell ($q,$q->b($domain))),
$q->Tr (esmith::cgi::genCell($q,$fm->localise('DESCRIPTION_BRIEF')),
esmith::cgi::genCell($q,$properties{'Description'})),
$q->Tr (esmith::cgi::genCell ($q,$fm->localise('CONTENT')),
esmith::cgi::genCell ($q, $q->b($content))),
$q->Tr (esmith::cgi::genCell ($q, $fm->localise('SERVERS_LABEL')),
genServer($q, $extraprops{'dns'})),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('NAME_LABEL'),
"login","")),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('PASSWORD_LABEL'),
"password","")),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('MX'),
"mx","")),
esmith::cgi::genButtonRow ( $q,
$q->submit (-name => 'action',
-value => $fm->localise('CREATE'))));
print $q->hidden (-name => 'domainName',
-override => 1,
-default => $domain);
print $q->hidden (-name => 'state',
-override => 1,
-default => 'performCreate');
print $q->endform;
esmith::cgi::genFooter ($q);
return;
}
#------------------------------------------------------------
#
#------------------------------------------------------------
sub performCreateDomain ($)
{
my ($q) = @_;
#------------------------------------------------------------
# Validate parameters and untaint them
#------------------------------------------------------------
my $domainName = $q->param ('domainName');
if ($domainName =~ /^([a-zA-Z0-9\-\.]+)$/)
{
$domainName = $1;
}
else
{
showInitial ($q, $fm->localise('DOMAIN_NAME_VALIDATION_ERROR',
{domainName => $domainName}));
return;
}
my $domainLogin = $q->param ('login');
if ($domainLogin =~ /^([\-\'\w][\-\'\w\s\.\@]*)$/)
{
$domainLogin = $1;
}
else
{
showInitial ($q, $fm->localise('DOMAIN_LOGIN_VALIDATION_ERROR',
{domainLogin => $domainLogin}));
return;
}
my $domainPassword = $q->param ('password');
if ($domainPassword =~ /^(.*)$/)
{
$domainPassword = $1;
}
else
{
showInitial ($q, $fm->localise('DOMAIN_PASSWORD_VALIDATION_ERROR',
{domainPassword => $domainPassword}));
return;
}
my $domainMX = $q->param ('mx');
#------------------------------------------------------------
# Looks good. Find out if this domain has been taken
# or if the domain is a reserved to provide a secured webserver
# for a previous domain
#------------------------------------------------------------
my $dns = $q->param ('dns');
my %properties = ();
$properties{'type'} = 'domain';
$properties{'dns'} = $dns;
$properties{'login'} = $domainLogin;
$properties{'password'} = $domainPassword;
$properties{'mx'} = $domainMX;
$domaindb->new_record($domainName, \%properties);
system ("/sbin/e-smith/signal-event", "domain-create");
showInitial ($q, $fm->localise('SUCCESSFULLY_CREATED',
{domainName => $domainName,dns => $fm->localise($dns) }));
}
#------------------------------------------------------------
#
#------------------------------------------------------------
sub modifyDomain ($)
{
my ($q) = @_;
esmith::cgi::genHeaderNonCacheable ($q, \%conf,
$fm->localise('MODIFY_TITLE'));
print $q->startform (-method => 'POST', -action => $q->url (-absolute => 1));
my $domain = $q->param ('domain');
my $value = $domaindb->get($domain);
my $evalue = $domaindb->get($domain);
if ($value)
{
my %properties = $value->props;
my %eprops = $evalue->props;
my $content;
if ($properties{'Content'} eq 'wwwpublic')
{
$content = $fm->localise('PRIMARY_SITE');
}
else
{
$content = $fm->localise('CONTENT',
{content => $properties{'Content'}});
}
print $q->h3 ($fm->localise('CUSTOM_DESCRIPTION'));
print $q->p;
print $q->table ({border => 0, cellspacing => 0, cellpadding => 4},
$q->Tr (esmith::cgi::genCell ($q,
$fm->localise('DOMAIN_NAME')),
esmith::cgi::genCell ($q, $domain)),
$q->Tr (esmith::cgi::genCell ($q,
$fm->localise('DESCRIPTION_BRIEF')),
esmith::cgi::genCell ($q, $properties {'Description'})),
$q->Tr (esmith::cgi::genCell ($q,
$fm->localise('CONTENT')),
esmith::cgi::genCell ($q, $content)),
$q->Tr (esmith::cgi::genCell ($q, $fm->localise('SERVERS_LABEL')),
genServer($q, $eprops{'dns'})),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('CUSTOMDNS_LABEL'),
"customdns",
$eprops{'customdns'})),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('CUSTOM_PROTOCOL_LABEL'),
"customprotocol",
$eprops{'customprotocol'})),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('NAME_LABEL'),
"login",
$eprops{'login'})),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('PASSWORD_LABEL'),
"password",
$eprops{'password'})),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('MX'),
"mx",$eprops{'mx'})),
esmith::cgi::genButtonRow ($q,
$q->submit (-name => 'action',
-value => $fm->localise('MODIFY'))));
print $q->hidden (-name => 'domainName',
-override => 1,
-default => $domain);
print $q->hidden (-name => 'state',
-override => 1,
-default => 'performModify');
}
print $q->endform;
esmith::cgi::genFooter ($q);
return;
}
#------------------------------------------------------------
#
#------------------------------------------------------------
sub performModifyDomain ($)
{
my ($q) = @_;
#------------------------------------------------------------
# Validate parameters and untaint them
#------------------------------------------------------------
my $domainName = $q->param ('domainName');
if ($domainName =~ /^([a-zA-Z0-9\-\.]+)$/)
{
$domainName = $1;
}
else
{
showInitial ($q, $fm->localise('DOMAIN_NAME_VALIDATION_ERROR',
{domainName => $domainName}));
return;
}
my $domainLogin = $q->param ('login');
if ($domainLogin =~ /^([\-\'\w][\-\'\w\s\.\@]*)$/)
{
$domainLogin = $1;
}
else
{
showInitial ($q, $fm->localise('DOMAIN_LOGIN_VALIDATION_ERROR',
{domainLogin => $domainLogin}));
return;
}
my $domainPassword = $q->param ('password');
if ($domainPassword =~ /^(.*)$/)
{
$domainPassword = $1;
}
else
{
showInitial ($q, $fm->localise('DOMAIN_PASSWORD_VALIDATION_ERROR',
{domainPassword => $domainPassword}));
return;
}
my $domainMX = $q->param ('mx');
my $customDNS = $q->param('customdns');
my $customPROTOCOL = $q->param('customprotocol');
my $dns = $q->param ('dns');
if ($dns eq 'CUSTOMDNS')
{
if ($customDNS =~ /^([a-zA-Z0-9\-\.]+)$/)
{
$customDNS = $1;
}
else
{
showInitial ($q, $fm->localise('CUSTOMDNS_VALIDATION_ERROR',
{domainName => $domainName}));
return;
}
}
#------------------------------------------------------------
# Looks good. Find out if this domain has been taken
# or if the domain is a reserved to provide a secured webserver
# for a previous domain
#------------------------------------------------------------
# my $dns = $q->param ('dns');
my $dom=$domaindb->get($domainName);
$dom->set_prop('dns' => $dns);
$dom->set_prop('login' => $domainLogin);
$dom->set_prop('password' => $domainPassword);
$dom->set_prop('mx' => $domainMX);
$dom->set_prop('customdns' => $customDNS);
$dom->set_prop('customprotocol' => $customPROTOCOL);
$domaindb->reload();
system ("/sbin/e-smith/signal-event", "domain-modify");
showInitial ($q, $fm->localise('SUCCESSFULLY_MODIFIED',
{domainName => $domainName,dns => $fm->localise($dns)}));
}
#------------------------------------------------------------
#
#------------------------------------------------------------
sub deleteDomain ($)
{
my ($q) = @_;
esmith::cgi::genHeaderNonCacheable ($q, \%conf, $fm->localise('REMOVE_TITLE'));
print $q->startform (-method => 'POST', -action => $q->url (-absolute => 1));
my $domain = $q->param ('domain');
my $value = $domaindb->get($domain);
my $evalue = $domaindb->get($domain);
if ($value)
{
my %properties = $value->props;
my $type = $properties{'type'};
my $domainDesc = $properties{'Description'};
my %eprops = $evalue->props;
my $dns=$fm->localise($eprops{'dns'});
print $q->p($fm->localise('REMOVE_DESCRIPTION',
{domain => $domain,
domainDesc => $domainDesc,
dns => $dns } ));
print $q->submit (-name => 'action', -value => $fm->localise('REMOVE'));
print $q->hidden (-name => 'domain', -override => 1, -default => $domain);
print $q->hidden (-name => 'state',
-override => 1,
-default => 'performDelete');
}
print $q->endform;
esmith::cgi::genFooter ($q);
return;
}
#------------------------------------------------------------
#
#------------------------------------------------------------
sub performDeleteDomain ($)
{
my ($q) = @_;
#------------------------------------------------------------
# Attempt to delete domain
#------------------------------------------------------------
my $domain = $q->param ('domain');
if ($domain =~ /^([a-zA-Z0-9\-\.]+)$/)
{
$domain = $1;
}
else
{
showInitial ($q, $fm->localise('ERROR_WHILE_REMOVING_DOMAIN',
{domain => $domain}));
return;
}
my $value = $domaindb->get($domain);
unless ($value)
{
showInitial ($q, $fm->localise('NONEXISTENT_DOMAIN_ERROR',
{domainName => $domain}));
return;
}
my %properties = $value->props;
my $type = $properties{'type'};
if ($type ne 'domain')
{
showInitial ($q, $fm->localise('NONEXISTENT_DOMAIN_ERROR',
{domainName => $domain}));
return;
}
my $evalue = $domaindb->get($domain);
my %props = $evalue->props;
my $dns = $fm->localise($props{'dns'});
$evalue->set_prop('dns' => '');
$evalue->set_prop('login' => '');
$evalue->set_prop('password' => '');
$evalue->set_prop('customdns' => '');
$evalue->set_prop('customprotocol' => '');
$domaindb->reload();
system ("/sbin/e-smith/signal-event", "domain-delete");
showInitial ($q, $fm->localise('SUCCESSFULLY_DELETED',
{domain => $domain, dns => $dns}));
}
#######################################################################
# create a free publish
#
sub ddcreateDomain ($)
{
my ($q) = @_;
esmith::cgi::genHeaderNonCacheable
($q, \%conf, $fm->localise('CREATE_TITLE'));
print $q->startform (-method => 'POST',
-action => $q->url (-absolute => 1));
print $q->h3 ($fm->localise('CUSTOM_DESCRIPTION'));
print $q->p;
print $q->table ({border => 0, cellspacing => 0, cellpadding => 4},
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('DOMAIN_NAME_LABEL'),
"domainName","")),
$q->Tr (esmith::cgi::genNameValueRow($q,$fm->localise('DESCRIPTION_LABEL'),
"desc","")),
$q->Tr (esmith::cgi::genCell ($q, $fm->localise('SERVERS_LABEL')),
genServer($q, '')),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('CUSTOMDNS_LABEL'),
"customdns",'')),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('CUSTOM_PROTOCOL_LABEL'),
"customprotocol",'')),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('NAME_LABEL'),
"login","")),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('PASSWORD_LABEL'),
"password","")),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('MX'),
"mx","")),
esmith::cgi::genButtonRow ( $q,
$q->submit (-name => 'action',
-value => $fm->localise('CREATE'))));
print $q->hidden (-name => 'state',
-override => 1,
-default => 'ddperformCreate');
print $q->endform;
esmith::cgi::genFooter ($q);
return;
}
#------------------------------------------------------------
#
#------------------------------------------------------------
sub ddperformCreateDomain ($)
{
my ($q) = @_;
#------------------------------------------------------------
# Validate parameters and untaint them
#------------------------------------------------------------
my $domainName = $q->param ('domainName');
if ($domainName =~ /^([a-zA-Z0-9\-\.]+)$/) {
$domainName = $1;
} else {
showInitial ($q, $fm->localise('DOMAIN_NAME_VALIDATION_ERROR',
{domainName => $domainName}));
return;
}
###############################################
foreach my $domain ($domaindb->get_all_by_prop(type=>'domain'))
{
my $key = $domain->key;
if ( $key eq $domainName ) {
showInitial ($q, $fm->localise('DOMAIN_NAME_ALREADY_EXIST',
{domainName => $domainName}));
return;
}
}
foreach my $domain ($edb->get_all_by_prop(type=>'ddhost'))
{
my $key = $domain->key;
if ( $key eq $domainName ) {
showInitial ($q, $fm->localise('DOMAIN_NAME_ALREADY_EXIST',
{domainName => $domainName}));
return;
}
}
#############################################
my $domainDesc = $q->param ('desc');
my $domainLogin = $q->param ('login');
if ($domainLogin =~ /^([\-\'\w][\-\'\w\s\.\@]*)$/) {
$domainLogin = $1;
} else {
showInitial ($q, $fm->localise('DOMAIN_LOGIN_VALIDATION_ERROR',
{domainLogin => $domainLogin}));
return;
}
my $domainPassword = $q->param ('password');
if ($domainPassword =~ /^(.*)$/) {
$domainPassword = $1;
} else {
showInitial ($q, $fm->localise('DOMAIN_PASSWORD_VALIDATION_ERROR',
{domainPassword => $domainPassword}));
return;
}
my $domainMX = $q->param ('mx');
##Custom dns retrieve
my $customDNS = $q->param('customdns');
my $customPROTOCOL = $q->param('customprotocol');
my $dns = $q->param ('dns');
if ($dns eq 'CUSTOMDNS')
{
if ($customDNS =~ /^([a-zA-Z0-9\-\.]+)$/)
{
$customDNS = $1;
}
else
{
showInitial ($q, $fm->localise('CUSTOMDNS_VALIDATION_ERROR',
{domainName => $domainName}));
return;
}
}
#------------------------------------------------------------
# Looks good. Find out if this domain has been taken
# or if the domain is a reserved to provide a secured webserver
# for a previous domain
#------------------------------------------------------------
# my $dns = $q->param ('dns');
my %properties = ();
$properties{'type'} = 'ddhost';
$properties{'dns'} = $dns;
$properties{'login'} = $domainLogin;
$properties{'password'} = $domainPassword;
$properties{'mx'} = $domainMX;
$properties{'desc'} = $domainDesc;
$properties{'customdns'} = $customDNS;
$properties{'customprotocol'} = $customPROTOCOL;
$edb->new_record($domainName, \%properties);
system ("/sbin/e-smith/signal-event", "domain-create");
showInitial ($q, $fm->localise('SUCCESSFULLY_CREATED',
{domainName => $domainName,dns => $fm->localise($dns) }));
}
#------------------------------------------------------------
#
#------------------------------------------------------------
sub ddmodifyDomain ($)
{
my ($q) = @_;
esmith::cgi::genHeaderNonCacheable ($q, \%conf,
$fm->localise('MODIFY_TITLE'));
print $q->startform (-method => 'POST', -action => $q->url (-absolute => 1));
my $domain = $q->param ('domain');
my $evalue = $edb->get($domain);
if (defined $evalue)
{
my %eprops = $evalue->props;
print $q->h3 ($fm->localise('CUSTOM_DESCRIPTION'));
print $q->p;
print $q->table ({border => 0, cellspacing => 0, cellpadding => 4},
$q->Tr (esmith::cgi::genCell ($q, $fm->localise('DOMAIN_NAME_LABEL')),
esmith::cgi::genCell ($q, $domain)),
$q->Tr (esmith::cgi::genNameValueRow ($q, $fm->localise('DESCRIPTION_LABEL'),
"desc",
$eprops{'desc'})),
$q->Tr (esmith::cgi::genCell ($q, $fm->localise('SERVERS_LABEL')),
genServer($q, $eprops{'dns'})),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('CUSTOMDNS_LABEL'),
"customdns",
$eprops{'customdns'})),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('CUSTOM_PROTOCOL_LABEL'),
"customprotocol",
$eprops{'customprotocol'})),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('NAME_LABEL'),
"login",
$eprops{'login'})),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('PASSWORD_LABEL'),
"password",
$eprops{'password'})),
$q->Tr (esmith::cgi::genNameValueRow ($q,$fm->localise('MX'),
"mx",$eprops{'mx'})),
esmith::cgi::genButtonRow ($q,
$q->submit (-name => 'action',
-value => $fm->localise('MODIFY')))
);
print $q->hidden (-name => 'domainName',
-override => 1,
-default => $domain);
print $q->hidden (-name => 'state',
-override => 1,
-default => 'ddperformModify');
} else {
showInitial ($q, $fm->localise('ERROR_ON_EXTRA_DATABASE',
{domainName => $domain }));
return;
}
print $q->endform;
esmith::cgi::genFooter ($q);
return;
}
#------------------------------------------------------------
#
#------------------------------------------------------------
sub ddperformModifyDomain ($)
{
my ($q) = @_;
#------------------------------------------------------------
# Validate parameters and untaint them
#------------------------------------------------------------
my $domainName = $q->param ('domainName');
if ($domainName =~ /^([a-zA-Z0-9\-\.]+)$/) {
$domainName = $1;
} else {
showInitial ($q, $fm->localise('DOMAIN_NAME_VALIDATION_ERROR',
{domainName => $domainName}));
return;
}
my $domainLogin = $q->param ('login');
if ($domainLogin =~ /^([\-\'\w][\-\'\w\s\.\@]*)$/) {
$domainLogin = $1;
} else {
showInitial ($q, $fm->localise('DOMAIN_LOGIN_VALIDATION_ERROR',
{domainLogin => $domainLogin}));
return;
}
my $domainPassword = $q->param ('password');
if ($domainPassword =~ /^(.*)$/) {
$domainPassword = $1;
} else {
showInitial ($q, $fm->localise('DOMAIN_PASSWORD_VALIDATION_ERROR',
{domainPassword => $domainPassword}));
return;
}
my $domainMX = $q->param ('mx');
my $desc = $q->param ('desc');
my $customDNS = $q->param('customdns');
my $customPROTOCOL = $q->param('customprotocol');
my $dns = $q->param ('dns');
if ($dns eq 'CUSTOMDNS')
{
if ($customDNS =~ /^([a-zA-Z0-9\-\.]+)$/)
{
$customDNS = $1;
}
else
{
showInitial ($q, $fm->localise('CUSTOMDNS_VALIDATION_ERROR',
{domainName => $domainName}));
return;
}
}
#------------------------------------------------------------
# Looks good. Find out if this domain has been taken
# or if the domain is a reserved to provide a secured webserver
# for a previous domain
#------------------------------------------------------------
# my $dns = $q->param ('dns');
my $dom=$edb->get($domainName);
$dom->set_prop('desc' => $desc);
$dom->set_prop('dns' => $dns);
$dom->set_prop('login' => $domainLogin);
$dom->set_prop('password' => $domainPassword);
$dom->set_prop('mx' => $domainMX);
$dom->set_prop('customdns' => $customDNS);
$dom->set_prop('customprotocol' => $customPROTOCOL);
$edb->reload();
system ("/sbin/e-smith/signal-event", "domain-modify");
showInitial ($q, $fm->localise('SUCCESSFULLY_MODIFIED',
{domainName => $domainName,dns => $fm->localise($dns)}));
}
#------------------------------------------------------------
#
#------------------------------------------------------------
sub dddeleteDomain ($)
{
my ($q) = @_;
esmith::cgi::genHeaderNonCacheable ($q, \%conf, $fm->localise('REMOVE_TITLE'));
print $q->startform (-method => 'POST', -action => $q->url (-absolute => 1));
my $domain = $q->param ('domain');
my $evalue = $edb->get($domain);
if (defined $evalue)
{
my %eprops = $evalue->props;
my $domainDesc = $eprops{'desc'};
my $dns = $fm->localise($eprops{'dns'});
print $q->p($fm->localise('REMOVE_DESCRIPTION',
{domain => $domain,
domainDesc => $domainDesc,
dns => $dns } ));
print $q->submit (-name => 'action', -value => $fm->localise('REMOVE'));
print $q->hidden (-name => 'domain', -override => 1, -default => $domain);
print $q->hidden (-name => 'state',
-override => 1,
-default => 'ddperformDelete');
} else {
showInitial ($q, $fm->localise('ERROR_ON_EXTRA_DATABASE',
{domainName => $domain }));
return;
}
print $q->endform;
esmith::cgi::genFooter ($q);
return;
}
#------------------------------------------------------------
#
#------------------------------------------------------------
sub ddperformDeleteDomain ($)
{
my ($q) = @_;
#------------------------------------------------------------
# Attempt to delete domain
#------------------------------------------------------------
my $domain = $q->param ('domain');
if ($domain =~ /^([a-zA-Z0-9\-\.]+)$/) {
$domain = $1;
} else {
showInitial ($q, $fm->localise('ERROR_WHILE_REMOVING_DOMAIN',
{domain => $domain}));
return;
}
my $evalue = $edb->get($domain);
unless ($evalue)
{
showInitial ($q, $fm->localise('NONEXISTENT_DOMAIN_ERROR',
{domainName => $domain}));
return;
}
my %properties = $evalue->props;
my $type = $properties{'type'};
my $dns = $fm->localise($properties{'dns'});
if ($type ne 'ddhost')
{
showInitial ($q, $fm->localise('NONEXISTENT_DOMAIN_ERROR',
{domainName => $domain}));
return;
}
# $evalue = $edb->get($domain);
$evalue->delete;
$edb->reload();
system ("/sbin/e-smith/signal-event", "domain-delete");
showInitial ($q, $fm->localise('SUCCESSFULLY_DELETED',
{domain => $domain, dns => $dns}));
}
#######################################################################
__DATA__
<form>
</form>