344 lines
8.1 KiB
Perl
344 lines
8.1 KiB
Perl
|
#!/usr/bin/perl
|
||
|
|
||
|
# Copyright 2011 Inverse inc.
|
||
|
#
|
||
|
# See the enclosed file COPYING for license information (GPL).
|
||
|
# If you did not receive this file, see
|
||
|
# http://www.fsf.org/licensing/licenses/gpl.html
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
addressbook.pl - import addressbooks from SquirrelMail
|
||
|
|
||
|
=head1 SYNOPSIS
|
||
|
|
||
|
addressbook.pl --help
|
||
|
|
||
|
addressbook.pl --config <path> [--username <username>] [--verbose=<0,1,2] <filename>
|
||
|
|
||
|
=head1 DESCRIPTION
|
||
|
|
||
|
This script imports SquirrelMail .abook files into SOGo.
|
||
|
|
||
|
=head1 AUTHOR
|
||
|
|
||
|
=over
|
||
|
|
||
|
=item Francis Lachapelle <flachapelle@inverse.ca>
|
||
|
|
||
|
=back
|
||
|
|
||
|
=head1 COPYRIGHT
|
||
|
|
||
|
Copyright (c) 2011 Inverse inc
|
||
|
|
||
|
This program is available under the GPL.
|
||
|
|
||
|
=cut
|
||
|
|
||
|
use diagnostics;
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
|
||
|
use Config::Simple;
|
||
|
use Pod::Usage;
|
||
|
use Getopt::Long;
|
||
|
use Log::Log4perl;
|
||
|
use Digest::MD5 qw(md5_hex);
|
||
|
use HTTP::Request;
|
||
|
use LWP::UserAgent;
|
||
|
use MIME::Base64;
|
||
|
use XML::Simple;
|
||
|
|
||
|
$| = 1;
|
||
|
|
||
|
# Global variables
|
||
|
my $help = undef;
|
||
|
my $conffile = undef;
|
||
|
my $forceusername = undef;
|
||
|
my $username = undef;
|
||
|
my $pwdhash = undef;
|
||
|
my $folder_destination = undef;
|
||
|
my $logLevel = 1;
|
||
|
my @files = ();
|
||
|
my $ua = undef;
|
||
|
|
||
|
my $cardtemplate = <<EOF
|
||
|
BEGIN:VCARD
|
||
|
VERSION:3.0
|
||
|
PRODID:%s
|
||
|
UID:%s
|
||
|
FN:%s
|
||
|
NICKNAME:%s
|
||
|
EMAIL:%s
|
||
|
NOTE:%s
|
||
|
END:VCARD
|
||
|
EOF
|
||
|
;
|
||
|
my $prodid = "-//Inverse inc.//SOGo SquirrelMail Importer 1.0//EN";
|
||
|
|
||
|
GetOptions(
|
||
|
"config|c:s" => \$conffile,
|
||
|
"username|u:s" => \$forceusername,
|
||
|
"<>" => \&addFile,
|
||
|
"help|?" => \$help,
|
||
|
"verbose|v:i" => \$logLevel,
|
||
|
) or pod2usage( -verbose => 1);
|
||
|
|
||
|
pod2usage( -verbose => 2) if $help;
|
||
|
pod2usage( -verbose => 1) unless ($conffile && scalar(@files) > 0);
|
||
|
|
||
|
if ($logLevel == 0) {
|
||
|
$logLevel = 'WARN';
|
||
|
} elsif ($logLevel == 1) {
|
||
|
$logLevel = 'INFO';
|
||
|
} else {
|
||
|
$logLevel = 'DEBUG';
|
||
|
}
|
||
|
my $logConf = <<END;
|
||
|
log4perl.rootLogger = $logLevel, Logfile
|
||
|
log4perl.appender.Logfile = Log::Log4perl::Appender::Screen
|
||
|
log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout
|
||
|
log4perl.appender.Logfile.layout.ConversionPattern = %d %p> %m%n
|
||
|
END
|
||
|
|
||
|
Log::Log4perl->init( \$logConf );
|
||
|
my $logger = Log::Log4perl->get_logger('');
|
||
|
|
||
|
#
|
||
|
# Read preferences from file
|
||
|
#
|
||
|
my $cfg = new Config::Simple($conffile);
|
||
|
|
||
|
#
|
||
|
# Verify configuration paramaters
|
||
|
#
|
||
|
foreach ('sogo.url', 'sogo.username', 'sogo.password', 'addressbooks.folder_destination') {
|
||
|
unless ($cfg->param($_)) {
|
||
|
if (m/^(.+)\.(.+)$/) {
|
||
|
$logger->error("The paramter '$2' in the block [$1] is not defined in the configuration file $conffile");
|
||
|
exit 0;
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
# Remove last slash of URL if defined
|
||
|
if (substr($cfg->param('sogo.url'), -1, 1) eq '/') {
|
||
|
my $url = $cfg->param('sogo.url');
|
||
|
chop $url;
|
||
|
$cfg->param('sogo.url', $url);
|
||
|
}
|
||
|
|
||
|
# Build password hash
|
||
|
$pwdhash = encode_base64($cfg->param('sogo.username') . ':' . $cfg->param('sogo.password'));
|
||
|
|
||
|
$username = $forceusername if ($forceusername);
|
||
|
|
||
|
$ua = LWP::UserAgent->new();
|
||
|
$ua->agent('Mozilla/5.0');
|
||
|
$ua->timeout(1800);
|
||
|
|
||
|
foreach my $filename (@files) {
|
||
|
processFile($filename);
|
||
|
}
|
||
|
|
||
|
#
|
||
|
# Subroutines
|
||
|
#
|
||
|
|
||
|
sub addFile {
|
||
|
my $filename = shift;
|
||
|
|
||
|
push(@files, $filename);
|
||
|
}
|
||
|
|
||
|
sub processFile {
|
||
|
my $filename = shift;
|
||
|
my $url = undef;
|
||
|
my $count = 0;
|
||
|
my $err = 0;
|
||
|
|
||
|
unless ($forceusername) {
|
||
|
if ($filename =~ m/^(.+)(\.[^\.]+)$/) {
|
||
|
$username = $1;
|
||
|
}
|
||
|
else {
|
||
|
$username = undef;
|
||
|
}
|
||
|
}
|
||
|
unless ($username) {
|
||
|
$logger->warn("Can't identify owner of file $filename");
|
||
|
return;
|
||
|
}
|
||
|
if ($url = &addressBookExists($username, $cfg->param('addressbooks.folder_destination'))) {
|
||
|
$logger->warn("[$username] Addressbook \"".$cfg->param('addressbooks.folder_destination')."\" already exists ($url)");
|
||
|
}
|
||
|
else {
|
||
|
$logger->info("[$username] Addressbook \"".$cfg->param('addressbooks.folder_destination')."\" doesn't exist");
|
||
|
$url = &createAddressBook($username, $cfg->param('addressbooks.folder_destination'));
|
||
|
}
|
||
|
|
||
|
if ($url) {
|
||
|
if (open (FILE, $filename)) {
|
||
|
while (<FILE>) {
|
||
|
chomp;
|
||
|
next unless length;
|
||
|
my ($nickname, $givenname, $surname, $mail, $note) = split(/\|/);
|
||
|
my $uid = md5_hex($_);
|
||
|
my $card = sprintf($cardtemplate, $prodid, $uid, "$surname $givenname", $nickname, $mail, $note);
|
||
|
|
||
|
$count++;
|
||
|
$err++ unless (&createContact($uid,
|
||
|
$url . $uid . ".vcf",
|
||
|
$card));
|
||
|
}
|
||
|
close FILE;
|
||
|
|
||
|
$logger->info("[$username] Imported $filename: $count contacts ($err skipped)");
|
||
|
}
|
||
|
else {
|
||
|
$logger->error("Can't open $filename: $!");
|
||
|
}
|
||
|
}
|
||
|
else {
|
||
|
$logger->error("[$username] File $filename skipped (missing destination addressbook)");
|
||
|
}
|
||
|
}
|
||
|
|
||
|
sub url {
|
||
|
my ($username) = @_;
|
||
|
|
||
|
return $cfg->param('sogo.url') . "/SOGo/dav/$username/Contacts/";
|
||
|
}
|
||
|
|
||
|
sub addressBookExists
|
||
|
{
|
||
|
my ($username, $addressbook) = @_;
|
||
|
|
||
|
my $result = 0;
|
||
|
my $propfind = <<XML
|
||
|
<?xml version="1.0" encoding="utf-8"?>
|
||
|
<propfind xmlns="DAV:">
|
||
|
<prop>
|
||
|
<displayname/>
|
||
|
</prop>
|
||
|
</propfind>
|
||
|
XML
|
||
|
;
|
||
|
my $request = HTTP::Request->new();
|
||
|
$request->method('PROPFIND');
|
||
|
$request->uri(&url($username));
|
||
|
$request->header('Content-Type' => 'text/xml; charset=utf8');
|
||
|
$request->header('Content-Length' => length($propfind));
|
||
|
$request->header('Depth' => 1);
|
||
|
$request->header('Authorization' => "Basic $pwdhash");
|
||
|
$request->content($propfind);
|
||
|
|
||
|
my $response = &httpRequest($request, $username);
|
||
|
if ($response) {
|
||
|
my $xml = XMLin($response);
|
||
|
foreach my $ab (@{$xml->{'D:response'}}) {
|
||
|
my $displayname = $ab->{'D:propstat'}->{'D:prop'}->{'D:displayname'};
|
||
|
$logger->debug("[$username] Found addressbook \"$displayname\"");
|
||
|
if ($addressbook eq $displayname) {
|
||
|
$result = $cfg->param('sogo.url') . $ab->{'D:href'};
|
||
|
last;
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
return $result;
|
||
|
}
|
||
|
|
||
|
sub createAddressBook {
|
||
|
my ($username, $addressbook) = @_;
|
||
|
|
||
|
my $result = 0;
|
||
|
my $uid = md5_hex(localtime);
|
||
|
my $url = &url($username) . $uid;
|
||
|
my $proppatch = <<XML
|
||
|
<?xml version="1.0" encoding="utf-8"?>
|
||
|
<propertyupdate xmlns="DAV:">
|
||
|
<set>
|
||
|
<prop>
|
||
|
<displayname>%s</displayname>
|
||
|
</prop>
|
||
|
</set>
|
||
|
</propertyupdate>
|
||
|
XML
|
||
|
;
|
||
|
|
||
|
my $request = HTTP::Request->new();
|
||
|
$request->method('MKCOL');
|
||
|
$request->uri($url);
|
||
|
$request->header('Authorization' => "Basic $pwdhash");
|
||
|
|
||
|
my $response = &httpRequest($request, $username);
|
||
|
if ($response) {
|
||
|
$proppatch = sprintf($proppatch, $addressbook);
|
||
|
$request = HTTP::Request->new();
|
||
|
$request->method('PROPPATCH');
|
||
|
$request->uri($url);
|
||
|
$request->header('Content-Type' => 'text/xml; charset=utf8');
|
||
|
$request->header('Content-Length' => length($proppatch));
|
||
|
$request->header('Depth' => 0);
|
||
|
$request->header('Authorization' => "Basic $pwdhash");
|
||
|
$request->content($proppatch);
|
||
|
|
||
|
$response = &httpRequest($request, $username);
|
||
|
if ($response) {
|
||
|
$logger->info("[$username] Addressbook \"$addressbook\" created ($url)");
|
||
|
$result = $url . '/';
|
||
|
}
|
||
|
}
|
||
|
|
||
|
return $result;
|
||
|
}
|
||
|
|
||
|
sub createContact {
|
||
|
my ($uid, $url, $card) = @_;
|
||
|
|
||
|
my $request = HTTP::Request->new();
|
||
|
$request->method('PUT');
|
||
|
$request->uri($url);
|
||
|
$request->header('Content-Type' => 'text/vcard; charset=utf-8');
|
||
|
$request->header('Content-Length' => length($card));
|
||
|
$request->header('Authorization' => "Basic $pwdhash");
|
||
|
$request->content($card);
|
||
|
|
||
|
return (&httpRequest($request, $uid));
|
||
|
}
|
||
|
|
||
|
sub httpRequest {
|
||
|
my ($request, $uid) = @_;
|
||
|
|
||
|
my $result = undef;
|
||
|
my $i;
|
||
|
for ($i = 0; $i < 30; $i++) {
|
||
|
my $response = $ua->request($request);
|
||
|
if ($response->is_success) {
|
||
|
$logger->debug("[$username] HTTP request " . $request->method . " $uid: " . $response->status_line);
|
||
|
$result = $response->decoded_content || 1;
|
||
|
last;
|
||
|
}
|
||
|
else {
|
||
|
$logger->warn("[$username] HTTP request " . $request->method . " $uid: " . $response->status_line);
|
||
|
if ($response->code == 500) {
|
||
|
$logger->warn("[$username] HTTP request " . $request->method . " $uid: sleeping 2 secs");
|
||
|
sleep(2);
|
||
|
}
|
||
|
else {
|
||
|
$result = 0;
|
||
|
last;
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
if ($i == 30) {
|
||
|
$logger->error("[$username] HTTP request " . $request->method . " $uid: Can't reach server for the past 60 secs - exiting.");
|
||
|
exit(-4);
|
||
|
}
|
||
|
|
||
|
return $result;
|
||
|
}
|