273 lines
8.6 KiB
Perl
273 lines
8.6 KiB
Perl
#!/usr/bin/perl -w
|
|
#==============================================================================
|
|
# lat-domains
|
|
# ===========
|
|
# 0.9.0 (2004-09-08)
|
|
# (c)2003-2004 Altiplano bvba
|
|
#==============================================================================
|
|
package esmith;
|
|
use strict;
|
|
use esmith::config;
|
|
use esmith::db;
|
|
use esmith::util;
|
|
use Getopt::Long;
|
|
use Pod::Usage;
|
|
my %conf;
|
|
tie %conf, 'esmith::config';
|
|
my %accounts;
|
|
tie %accounts, 'esmith::config', '/home/e-smith/db/accounts';
|
|
my %domains;
|
|
tie %domains, 'esmith::config', '/home/e-smith/db/domains';
|
|
my ($Hlp, $Cml, $Frc, $Inp);
|
|
my $Add =0;
|
|
my $Del =0;
|
|
|
|
#==============================================================================
|
|
# Main
|
|
#==============================================================================
|
|
# Analyze commandline options
|
|
GetOptions ("help" => \$Hlp,
|
|
"add" => \$Add,
|
|
"delete" => \$Del,
|
|
"force" => \$Frc,
|
|
"command-line=s" => \$Cml,
|
|
"input-file=s" => \$Inp);
|
|
|
|
if ( $Hlp ) { &PrintPod(9); exit; }
|
|
|
|
# We need one argument or the other, but not both
|
|
if ((($Cml && $Inp) || (! $Cml && ! $Inp)) ||
|
|
($Add + $Del != 1))
|
|
{ &PrintPod(1); exit; }
|
|
|
|
|
|
my @records;
|
|
if ($Inp) {
|
|
open(LIST,"< $Inp") || die "Can't find $Inp.\n";
|
|
@records = grep(!/(^\s*#)|(^\s*$)/,<LIST>);
|
|
close(LIST); }
|
|
elsif ($Cml) { @records=($Cml); }
|
|
else { &PrintPod(1); exit; }
|
|
|
|
# Add domainnames
|
|
if ($Add) {
|
|
foreach my $record (@records)
|
|
{
|
|
my @fields=split(/\|/,$record);
|
|
for (my $cnt=0; $cnt <= $#fields; ++$cnt) { for ($fields[$cnt]) { s/^\s+//; s/\s+$//; }}
|
|
my $domainname = lc($fields[0]);
|
|
|
|
if ( ! db_get(\%domains, $domainname)) {
|
|
if ( &TestDomainName($domainname)) {
|
|
if (( ! db_get(\%accounts, $fields[2])) ||
|
|
(db_get_type(\%accounts, $fields[2])) ne "ibay")
|
|
{ $fields[2] = 'wwwpublic'; }
|
|
if ( ! $fields[1]) { $fields[1] = "Domainname '$domainname' for content at '$fields[2]'"; }
|
|
|
|
print "Creating domainname '$domainname'. Linked to '$fields[2]'.\n";
|
|
my %domain = ("Content", $fields[2],
|
|
"Description", $fields[1]);
|
|
db_set(\%domains, $domainname, 'domain', \%domain);
|
|
system ("/sbin/e-smith/signal-event", "domain-create", "$domainname") == 0
|
|
or die ("Error occurred while creating '$domainname'.\n");
|
|
}
|
|
}
|
|
else { print "The domainname '$domainname' already exists.\a\n"; }
|
|
}
|
|
}
|
|
|
|
# Delete domainnames
|
|
if ($Del) {
|
|
&ExpandWildCard; # Check for wildcards and expand if necessary
|
|
foreach my $record (@records)
|
|
{
|
|
my @fields=split(/\|/,$record);
|
|
for (my $cnt=0; $cnt <= $#fields; ++$cnt) { for ($fields[$cnt]) { s/^\s+//; s/\s+$//; }}
|
|
my $domainname = lc($fields[0]);
|
|
|
|
if ((db_get(\%domains, $domainname)) &&
|
|
(db_get_type(\%domains, $domainname)) eq "domain") {
|
|
my $yn = 'yes';
|
|
if (! $Frc) {
|
|
print "Do you want to delete domainname '$domainname' [yes/NO/all]? ";
|
|
$yn = <STDIN>;
|
|
if ($yn =~ /^a/i) { $Frc = -1; $yn="yes"; }
|
|
}
|
|
if ($yn =~ /^y/i) {
|
|
print "Deleting '$domainname'...\n";
|
|
db_delete(\%domains, $domainname);
|
|
system ("/sbin/e-smith/signal-event", "domain-delete", "$domainname") == 0
|
|
or die ("Error occurred while deleting '$domainname'.\n");
|
|
}
|
|
}
|
|
else { print "Can't find domainname '$domainname'.\n\a";}
|
|
}
|
|
}
|
|
|
|
#==============================================================================
|
|
# Subroutines
|
|
#==============================================================================
|
|
sub TestDomainName {
|
|
my $dname = $_[0];
|
|
if ($dname =~ /^[a-z][a-z0-9-.]*[a-z0-9]$/) {
|
|
$dname = $&;
|
|
return -1;
|
|
}
|
|
else {
|
|
print "Domainname contains illegal characters ($dname).\a\n";
|
|
return 0;
|
|
}
|
|
}
|
|
#==============================================================================
|
|
# Test for wildcards in the domainname. If any wildecards are found, the array
|
|
# @records is expanded with the domainnames that meet the conditions.
|
|
sub ExpandWildCard {
|
|
my $ctrec = 0;
|
|
foreach my $record (@records)
|
|
{
|
|
my @fld=split(/\|/,$record);
|
|
for (my $cnt=0; $cnt <= $#fld; ++$cnt) { for ($fld[$cnt]) { s/^\s+//; s/\s+$//; }}
|
|
|
|
if ($fld[0] =~ /\*|\?/) { # Does it contain the wildcards?
|
|
$fld[0] =~ s/\*/\.\*/g; # Replace * with .* to allow for grep.
|
|
$fld[0] =~ s/\?/\./g; # Replace ? with . to allow for grep.
|
|
|
|
open USRS, "</home/e-smith/db/domains" or die "Can't open /home/e-smith/db/domains: $!";
|
|
my @match = grep /^$fld[0]\=domain\|/i, <USRS>;
|
|
close(USRS);
|
|
|
|
my $cu = 0;
|
|
foreach my $tst (@match) {
|
|
$tst =~ /\=/; $tst = $`;
|
|
for (my $cnt=1; $cnt <= $#fld; ++$cnt) { $tst = $tst." | ".$fld[$cnt]; };
|
|
if ($cu == 0 ) {
|
|
$records[$ctrec] = $tst;
|
|
$cu =1;
|
|
}
|
|
else {
|
|
push(@records, $tst);
|
|
}
|
|
}
|
|
}
|
|
++$ctrec;
|
|
}
|
|
}
|
|
#==============================================================================
|
|
# Print the pod text as a help screen
|
|
sub PrintPod {
|
|
my ($verbose, $message) = @_;
|
|
pod2usage(-verbose => $verbose, -message => $message, -exitval => 64);
|
|
}
|
|
|
|
#==============================================================================
|
|
=pod
|
|
|
|
=head1 NAME
|
|
|
|
B<lat-domains> - The lazy administrator's tool to manage domainnames
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Creates or deletes domainnames on Mitel's SME servers.
|
|
This tool is functionally equivalent to the 'virtual domains' option in the server-manager, but can be run from the command line or called from an other script.
|
|
It allows you, for example, to create a large number of domain names in a batch process, or delete domain names on a remote machine via an ssh console.
|
|
|
|
See F</usr/doc/lazy-admin-tools/example.domains> for the format of the input file.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
B<lat-domains> -a -c "domain | description | i-bay"
|
|
|
|
B<lat-domains> -a -i /path/to/domains.list
|
|
|
|
B<lat-domains> -d [-f] -c "domain"
|
|
|
|
B<lat-domains> -d [-f] -i /path/to/domains.list
|
|
|
|
=head1 OPTIONS
|
|
|
|
The following options are supported:
|
|
|
|
=over 4
|
|
|
|
=item B<-a>, B<--add>
|
|
|
|
Add a domain name to the server
|
|
|
|
=item B<-c "Arguments">, B<--command-line="Arguments">
|
|
|
|
Take arguments from the command line.
|
|
See the 'Arguments' section below for the various arguments that are accepted.
|
|
|
|
=item B<-d>, B<--delete>
|
|
|
|
Delete a domain name from the server. Wildcards (* and ?) are accepted.
|
|
|
|
=item B<-f>, B<--force>
|
|
|
|
Don't prompt before deleting.
|
|
|
|
=item B<-h>, B<--help>
|
|
|
|
Extended help for this tool
|
|
|
|
=item B<-i FILE>, B<--input-file=FILE>
|
|
|
|
Use the information from FILE to create or delete the domain name(s).
|
|
See F</usr/doc/lazy-admin-tools> for an example of an input file.
|
|
|
|
=back
|
|
|
|
=head2 Arguments:
|
|
|
|
domain* : Must contain one or more letters, numbers,
|
|
periods and minus signs. Wildcards (* and ?)
|
|
can only be used to delete domainnames.
|
|
desription : Free text description of the domain.
|
|
i-bay : Location where the content for the website
|
|
can be found. Must be a valid ibay-name.
|
|
Otherwise the primary website of the server is
|
|
assumed.
|
|
|
|
* mandatory field
|
|
|
|
=head1 EXAMPLES
|
|
|
|
B<lat-domains -a -c "hogwarts.net | School of witchcraft | hogwarts">
|
|
|
|
Creates the domain name 'hogwarts.net' and links it to i-bay 'hogwarts'.
|
|
|
|
B<lat-domains -a -c "quidditch.net">
|
|
|
|
Creates the domain name 'quidditch.net' and links it to the primary website.
|
|
|
|
B<lat-domains -a -i /root/domains.list>
|
|
|
|
Creates the domain names defined in F</root/domains.list>.
|
|
Refer to F</usr/doc/lazy-admin-tools/example.domains> for an example of an input file.
|
|
|
|
B<lat-domains -d -f -c "*.net">
|
|
|
|
Deletes all '.net' domain names without prompting (-f).
|
|
|
|
=head1 SEE ALSO
|
|
|
|
lat-users(8), lat-group(8), lat-pseudonyms(8), lat-ibays(8), lat-quota(8), lat-hosts(8), lat-procmail(8), lat-pptp(8), lat-dump(8)
|
|
|
|
=head1 VERSION
|
|
|
|
Version 0.9.0 (2004-09-08). The latest version is hosted at B<http://www.contribs.org/contribs/mblotwijk/>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
(c)2003-2004, Altiplano bvba (B<http://www.altiplano.be>). Released under the terms of the GNU license.
|
|
|
|
|
|
=head1 BUGS
|
|
|
|
Please report bugs to <Bugs@Altiplano.Be>
|
|
|
|
=cut
|
|
|
|
#==============================================================================
|