Skip to content

Commit 1de1c3f

Browse files
cgxcgx
committed
Migration script for SquirrelMail (address books).
Monotone-Parent: 4debfaca0d50cac8183e4dcc9327b8a5ec8284dd Monotone-Revision: 2e5b0e4a79c403ee6edc14f5ee20c4e0decb6219 Monotone-Author: [email protected] Monotone-Date: 2011-11-15T09:57:56
1 parent 4d76080 commit 1de1c3f

File tree

3 files changed

+351
-1
lines changed

3 files changed

+351
-1
lines changed

‎Migration/SquirrelMail/addressbook.pl

Lines changed: 343 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,343 @@
1+
#!/usr/bin/perl
2+
3+
# Copyright 2011 Inverse inc.
4+
#
5+
# See the enclosed file COPYING for license information (GPL).
6+
# If you did not receive this file, see
7+
# http://www.fsf.org/licensing/licenses/gpl.html
8+
9+
=head1 NAME
10+
11+
addressbook.pl - import addressbooks from SquirrelMail
12+
13+
=head1 SYNOPSIS
14+
15+
addressbook.pl --help
16+
17+
addressbook.pl --config <path> [--username <username>] [--verbose=<0,1,2] <filename>
18+
19+
=head1 DESCRIPTION
20+
21+
This script imports SquirrelMail .abook files into SOGo.
22+
23+
=head1 AUTHOR
24+
25+
=over
26+
27+
=item Francis Lachapelle <[email protected]>
28+
29+
=back
30+
31+
=head1 COPYRIGHT
32+
33+
Copyright (c) 2011 Inverse inc
34+
35+
This program is available under the GPL.
36+
37+
=cut
38+
39+
use diagnostics;
40+
use strict;
41+
use warnings;
42+
43+
use Config::Simple;
44+
use Pod::Usage;
45+
use Getopt::Long;
46+
use Log::Log4perl;
47+
use Digest::MD5 qw(md5_hex);
48+
use HTTP::Request;
49+
use LWP::UserAgent;
50+
use MIME::Base64;
51+
use XML::Simple;
52+
53+
$| = 1;
54+
55+
# Global variables
56+
my $help = undef;
57+
my $conffile = undef;
58+
my $forceusername = undef;
59+
my $username = undef;
60+
my $pwdhash = undef;
61+
my $folder_destination = undef;
62+
my $logLevel = 1;
63+
my @files = ();
64+
my $ua = undef;
65+
66+
my $cardtemplate = <<EOF
67+
BEGIN:VCARD
68+
VERSION:3.0
69+
PRODID:%s
70+
UID:%s
71+
FN:%s
72+
NICKNAME:%s
73+
EMAIL:%s
74+
NOTE:%s
75+
END:VCARD
76+
EOF
77+
;
78+
my $prodid = "-//Inverse inc.//SOGo SquirrelMail Importer 1.0//EN";
79+
80+
GetOptions(
81+
"config|c:s" => \$conffile,
82+
"username|u:s" => \$forceusername,
83+
"<>" => \&addFile,
84+
"help|?" => \$help,
85+
"verbose|v:i" => \$logLevel,
86+
) or pod2usage( -verbose => 1);
87+
88+
pod2usage( -verbose => 2) if $help;
89+
pod2usage( -verbose => 1) unless ($conffile && scalar(@files) > 0);
90+
91+
if ($logLevel == 0) {
92+
$logLevel = 'WARN';
93+
} elsif ($logLevel == 1) {
94+
$logLevel = 'INFO';
95+
} else {
96+
$logLevel = 'DEBUG';
97+
}
98+
my $logConf = <<END;
99+
log4perl.rootLogger = $logLevel, Logfile
100+
log4perl.appender.Logfile = Log::Log4perl::Appender::Screen
101+
log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout
102+
log4perl.appender.Logfile.layout.ConversionPattern = %d %p> %m%n
103+
END
104+
105+
Log::Log4perl->init( \$logConf );
106+
my $logger = Log::Log4perl->get_logger('');
107+
108+
#
109+
# Read preferences from file
110+
#
111+
my $cfg = new Config::Simple($conffile);
112+
113+
#
114+
# Verify configuration paramaters
115+
#
116+
foreach ('sogo.url', 'sogo.username', 'sogo.password', 'addressbooks.folder_destination') {
117+
unless ($cfg->param($_)) {
118+
if (m/^(.+)\.(.+)$/) {
119+
$logger->error("The paramter '$2' in the block [$1] is not defined in the configuration file $conffile");
120+
exit 0;
121+
}
122+
}
123+
}
124+
125+
# Remove last slash of URL if defined
126+
if (substr($cfg->param('sogo.url'), -1, 1) eq '/') {
127+
my $url = $cfg->param('sogo.url');
128+
chop $url;
129+
$cfg->param('sogo.url', $url);
130+
}
131+
132+
# Build password hash
133+
$pwdhash = encode_base64($cfg->param('sogo.username') . ':' . $cfg->param('sogo.password'));
134+
135+
$username = $forceusername if ($forceusername);
136+
137+
$ua = LWP::UserAgent->new();
138+
$ua->agent('Mozilla/5.0');
139+
$ua->timeout(1800);
140+
141+
foreach my $filename (@files) {
142+
processFile($filename);
143+
}
144+
145+
#
146+
# Subroutines
147+
#
148+
149+
sub addFile {
150+
my $filename = shift;
151+
152+
push(@files, $filename);
153+
}
154+
155+
sub processFile {
156+
my $filename = shift;
157+
my $url = undef;
158+
my $count = 0;
159+
my $err = 0;
160+
161+
unless ($forceusername) {
162+
if ($filename =~ m/^(.+)(\.[^\.]+)$/) {
163+
$username = $1;
164+
}
165+
else {
166+
$username = undef;
167+
}
168+
}
169+
unless ($username) {
170+
$logger->warn("Can't identify owner of file $filename");
171+
return;
172+
}
173+
if ($url = &addressBookExists($username, $cfg->param('addressbooks.folder_destination'))) {
174+
$logger->warn("[$username] Addressbook \"".$cfg->param('addressbooks.folder_destination')."\" already exists ($url)");
175+
}
176+
else {
177+
$logger->info("[$username] Addressbook \"".$cfg->param('addressbooks.folder_destination')."\" doesn't exist");
178+
$url = &createAddressBook($username, $cfg->param('addressbooks.folder_destination'));
179+
}
180+
181+
if ($url) {
182+
if (open (FILE, $filename)) {
183+
while (<FILE>) {
184+
chomp;
185+
next unless length;
186+
my ($nickname, $givenname, $surname, $mail, $note) = split(/\|/);
187+
my $uid = md5_hex($_);
188+
my $card = sprintf($cardtemplate, $prodid, $uid, "$surname $givenname", $nickname, $mail, $note);
189+
190+
$count++;
191+
$err++ unless (&createContact($uid,
192+
$url . $uid . ".vcf",
193+
$card));
194+
}
195+
close FILE;
196+
197+
$logger->info("[$username] Imported $filename: $count contacts ($err skipped)");
198+
}
199+
else {
200+
$logger->error("Can't open $filename: $!");
201+
}
202+
}
203+
else {
204+
$logger->error("[$username] File $filename skipped (missing destination addressbook)");
205+
}
206+
}
207+
208+
sub url {
209+
my ($username) = @_;
210+
211+
return $cfg->param('sogo.url') . "/SOGo/dav/$username/Contacts/";
212+
}
213+
214+
sub addressBookExists
215+
{
216+
my ($username, $addressbook) = @_;
217+
218+
my $result = 0;
219+
my $propfind = <<XML
220+
<?xml version="1.0" encoding="utf-8"?>
221+
<propfind xmlns="DAV:">
222+
<prop>
223+
<displayname/>
224+
</prop>
225+
</propfind>
226+
XML
227+
;
228+
my $request = HTTP::Request->new();
229+
$request->method('PROPFIND');
230+
$request->uri(&url($username));
231+
$request->header('Content-Type' => 'text/xml; charset=utf8');
232+
$request->header('Content-Length' => length($propfind));
233+
$request->header('Depth' => 1);
234+
$request->header('Authorization' => "Basic $pwdhash");
235+
$request->content($propfind);
236+
237+
my $response = &httpRequest($request, $username);
238+
if ($response) {
239+
my $xml = XMLin($response);
240+
foreach my $ab (@{$xml->{'D:response'}}) {
241+
my $displayname = $ab->{'D:propstat'}->{'D:prop'}->{'D:displayname'};
242+
$logger->debug("[$username] Found addressbook \"$displayname\"");
243+
if ($addressbook eq $displayname) {
244+
$result = $cfg->param('sogo.url') . $ab->{'D:href'};
245+
last;
246+
}
247+
}
248+
}
249+
250+
return $result;
251+
}
252+
253+
sub createAddressBook {
254+
my ($username, $addressbook) = @_;
255+
256+
my $result = 0;
257+
my $uid = md5_hex(localtime);
258+
my $url = &url($username) . $uid;
259+
my $proppatch = <<XML
260+
<?xml version="1.0" encoding="utf-8"?>
261+
<propertyupdate xmlns="DAV:">
262+
<set>
263+
<prop>
264+
<displayname>%s</displayname>
265+
</prop>
266+
</set>
267+
</propertyupdate>
268+
XML
269+
;
270+
271+
my $request = HTTP::Request->new();
272+
$request->method('MKCOL');
273+
$request->uri($url);
274+
$request->header('Authorization' => "Basic $pwdhash");
275+
276+
my $response = &httpRequest($request, $username);
277+
if ($response) {
278+
$proppatch = sprintf($proppatch, $addressbook);
279+
$request = HTTP::Request->new();
280+
$request->method('PROPPATCH');
281+
$request->uri($url);
282+
$request->header('Content-Type' => 'text/xml; charset=utf8');
283+
$request->header('Content-Length' => length($proppatch));
284+
$request->header('Depth' => 0);
285+
$request->header('Authorization' => "Basic $pwdhash");
286+
$request->content($proppatch);
287+
288+
$response = &httpRequest($request, $username);
289+
if ($response) {
290+
$logger->info("[$username] Addressbook \"$addressbook\" created ($url)");
291+
$result = $url . '/';
292+
}
293+
}
294+
295+
return $result;
296+
}
297+
298+
sub createContact {
299+
my ($uid, $url, $card) = @_;
300+
301+
my $request = HTTP::Request->new();
302+
$request->method('PUT');
303+
$request->uri($url);
304+
$request->header('Content-Type' => 'text/vcard; charset=utf-8');
305+
$request->header('Content-Length' => length($card));
306+
$request->header('Authorization' => "Basic $pwdhash");
307+
$request->content($card);
308+
309+
return (&httpRequest($request, $uid));
310+
}
311+
312+
sub httpRequest {
313+
my ($request, $uid) = @_;
314+
315+
my $result = undef;
316+
my $i;
317+
for ($i = 0; $i < 30; $i++) {
318+
my $response = $ua->request($request);
319+
if ($response->is_success) {
320+
$logger->debug("[$username] HTTP request " . $request->method . " $uid: " . $response->status_line);
321+
$result = $response->decoded_content || 1;
322+
last;
323+
}
324+
else {
325+
$logger->warn("[$username] HTTP request " . $request->method . " $uid: " . $response->status_line);
326+
if ($response->code == 500) {
327+
$logger->warn("[$username] HTTP request " . $request->method . " $uid: sleeping 2 secs");
328+
sleep(2);
329+
}
330+
else {
331+
$result = 0;
332+
last;
333+
}
334+
}
335+
}
336+
337+
if ($i == 30) {
338+
$logger->error("[$username] HTTP request " . $request->method . " $uid: Can't reach server for the past 60 secs - exiting.");
339+
exit(-4);
340+
}
341+
342+
return $result;
343+
}

‎Migration/SquirrelMail/default.conf

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
[sogo]
2+
url = http://localhost/
3+
username = sogo
4+
password = qwerty
5+
6+
[addressbooks]
7+
folder_destination = "Imported Contacts"

‎NEWS

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
1.3-20111028 (1.3.10)
22
---------------------
33
New Features
4-
-
4+
- new migration script for SquirrelMail (address books)
55

66
Enhancements
77
- updated Norwegian translation

0 commit comments

Comments
 (0)