Hi, All! That's a pity, that nobody reply to my help request :-(
I wrote Perl script for myself and it restored 6482 email from k9 sqlite database. Script(translator) actual only with current K9-Mail database schema and its usage by real app code. As I can see, script can restore any kind of messages(multiparts ans others) include attachments which were downloaded by K9-Mail client. Result is mbox files, one per folder. This mbox files I successfully imported to Thunderbird and then moved to my IMAP server. Script distributed AS-IS. p.s. script may have huge output, I recommend to redirect it to log file. p.p.s. script is very slow... As I can understand it is due to Mail::Header Perl module and "magic" Perl "open" function... Regards, Alexey (aka Alukardd) -- You received this message because you are subscribed to the Google Groups "K-9 Mail" group. To unsubscribe from this group and stop receiving emails from it, send an email to [email protected]. For more options, visit https://groups.google.com/d/optout.
#!/usr/bin/env perl # # created by Alukardd© # # # this script is distributed AS-IS # without any guarantee or support # # # this script was initially based on another python script # see https://groups.google.com/forum/#!topic/k-9-mail/xjNz0PXZfD8 # use 5.010; use strict; use warnings; use experimental 'smartmatch'; use Data::Dumper; use Getopt::Long qw( :config posix_default bundling no_ignore_case ); use Pod::Usage; use File::Spec; use File::Path qw( make_path ); use DBI; # apt install libdbd-sqlite3-perl use Mail::Box::Mbox; # apt install libmail-box-perl use Email::MIME; # apt install libemail-mime-perl #use MIME::Parser; # apt install libmime-tools-perl use MIME::Base64; use Mail::Header; use IO::All; # apt install libio-all-perl use Switch; ######################################## # Parse options # ######################################## sub usage { return "Usage:\n $0 <-f /--dbfile=/path/to-file> [--ram]\n"; } GetOptions( 'help|h' => \my $help, 'dbfile|f=s' => \my $dbfile, 'ram' => \my $ram, ) or die(usage()); print usage() if $help; die("You should specify dbfile!\n" . usage()) unless defined $dbfile; die("Can't read dbfile \"$dbfile\"\n" . usage()) unless -r $dbfile; ######################################## ######################################## # create the mailbox to write to my $mboxroot = 'k9-rescued-' . time() . '.mbox.d'; # if the heirarchy of folders doesn't exist yet, create it if (! -d $mboxroot) { make_path $mboxroot or die("Failed to create path: $mboxroot"); } ######################################## # Parse K9-Mail SQLite3 database # # And write result to mbox files # ######################################## # connect to a database my $db = DBI->connect("DBI:SQLite:dbname=$dbfile","","") or die("Can't open \"$dbfile\" as SQLite Database"); print STDERR "Database opened successfully\n"; # Get the names of all folders my $res = $db->selectall_arrayref(qq(select * from folders), { Slice => {} }) or die $DBI::errstr; my %folders = map { $_->{'id'} => $_->{'name'} } @$res; # Get metadata of all messages from K9 db my @exclude_folders = grep /\S/, map { $_ if lc($folders{$_}) ~~ ['spam', 'junk', 'trash'] } keys %folders; my $all_messages = $db->selectall_arrayref(qq(select * from messages), { Slice => {} }) or die $DBI::errstr; my @messages = grep { !($_->{'folder_id'} ~~ @exclude_folders) } @$all_messages; my $all_message_parts; if (defined $ram) { $all_message_parts = $db->selectall_arrayref(qq(select * from message_parts), { Slice => {} }) or die $DBI::errstr; } printf("Found %d messages (%d including trash and spam)\n", scalar @messages, scalar @$all_messages); for my $msg (@messages) { next unless defined $msg->{'uid'} and defined $msg->{'sender_list'} and defined $msg->{'to_list'}; #next unless $msg->{'id'} == 14718; $msg->{'subject'} = '' unless defined $msg->{'subject'}; printf("[%s][%d] %s -> %s (%s) : %s\n", $folders{$msg->{'folder_id'}}, $msg->{'id'}, $msg->{'sender_list'}, $msg->{'to_list'}, $msg->{'date'}, $msg->{'subject'}); # extract the name of the mbox we want to write to my $mboxname = File::Spec->catfile( $mboxroot, $folders{$msg->{'folder_id'}}); # open the mbox pointing there my $mbox = Mail::Box::Mbox->new(folder => $mboxname, folderdir => $mboxroot, access => 'rw', create => 'true'); my $email = Email::MIME->create(); my %parts; my $msg_parts; if (defined $ram) { $msg_parts = [ grep { $_->{'root'} == $msg->{'message_part_id'} } @$all_message_parts ]; } else { $msg_parts = $db->selectall_arrayref(qq(select * from message_parts where root=) . $msg->{'message_part_id'}, { Slice => {} }) or die $DBI::errstr; } # need to realize nested message parts like multipart/replated my $nested_root = 0; for my $msg_part (@$msg_parts) { # ugly hack for removing CR (0x0D == ) foreach (values %$msg_part) { next unless defined; s/\x0D//g; } print " Part id is $msg_part->{'id'} (seq $msg_part->{'seq'}) mime_type is $msg_part->{'mime_type'}" . ( defined $msg_part->{'encoding'} ? " encoding: " . $msg_part->{'encoding'} : "" ) . "\n"; # parse plain headers from db (VERY SLOW!!!) open my $h_fh, '<', \$msg_part->{'header'} or die $!; my $head = Mail::Header->new($h_fh)->header_hashref; close $h_fh or die $!; # Manual parsing (not working well) ###my @tmp_h; ###my $tmp_v; ###foreach my $l (split /\n/, $msg_part->{'header'}) { ### unless ($l =~ m/^([\w\-]+): (.+)/) { ### $tmp_v .= "\n$l"; ### next; ### } ### push @tmp_h, $tmp_v if $tmp_v; ### push @tmp_h, $1; ### $tmp_v = $2; ###} ###push @tmp_h, $tmp_v if $tmp_v; ####my $head = Mail::Header->new(\@tmp_h)->header_hashref; ###my $head = {}; ###for (my $i=0; $i < scalar(@tmp_h) - 1; $i += 2) { ### push @{$head->{$tmp_h[$i]}}, $tmp_h[$i+1]; ###} my $part = Email::MIME->create(); $part->body_set($msg_part->{'data'}) if defined $msg_part->{'data'}; # set header one by one... :-( for my $head_n (keys %$head) { my @values = map { chomp; s/\x0D//gr; } @{$head->{$head_n}}; # Yet another hack # Fucking parse_content_type function from Email::MIME package @values = map { s/\n//g; $_; } @values if lc $head_n eq lc 'Content-Type'; $part->header_set($head_n => @values); } # I don't know why I need it after seting all headers... #$part->content_type_set($msg_part->{'mime_type'}) if defined $msg_part->{'mime_type'}; switch($msg_part->{'mime_type'}) { case ['text/plain', 'text/html'] {} case ['multipart/alternative', 'multipart/mixed', 'multipart/related', 'multipart/report'] { if (defined $msg_part->{'boundary'} && $msg_part->{'parent'} != -1) { $nested_root = $msg_part->{'seq'}; } } else { $part->body_set("base64file") unless defined $msg_part->{'data'}; switch($msg_part->{'data_location'}) { case 0 { $part->body_set("file was't downloaded"); } case 1 {} case 2 { $part->body_set(MIME::Base64::decode(io($dbfile . '_att/' . $msg_part->{'id'})->binary->all)); } } } } unless ($msg_part->{'parent'} == -1) { # yet another ugly hack for mbox purity @{$part->{header}->{headers}} = @{$part->{header}->{headers}}[4..$#{$part->{header}->{headers}}] if $#{$part->{header}->{headers}} > 4; #my $idx = 0; #while ($idx <= $#{$part->{header}->{headers}} ) { # my $v = @{$part->{header}->{headers}}[$idx]; # if ($v eq 'Date' || $v eq 'MIME-Version') { # splice @{$part->{header}->{headers}}, $idx, 2; # } else { # $idx++; # } #} } push @{$parts{$msg_part->{'parent'}}->{'parts'}}, $msg_part->{'id'} unless $msg_part->{'parent'} == -1; $parts{$msg_part->{'id'}}->{'self'} = $part; } # build email body $email = $parts{$msg->{'message_part_id'}}->{'self'}; for my $p (sort {$b <=> $a} keys %parts) { # sort is needed for use parts_set from bottom to up!!! next unless $parts{$p}->{'parts'}; my @tmp_parts; foreach my $child (@{$parts{$p}->{'parts'}}) { push @tmp_parts, $parts{$child}->{'self'}; } $parts{$p}->{'self'}->parts_set(\@tmp_parts); } say $email->debug_structure; $mbox->addMessage($email); $mbox->close(); } # quit the database $db->disconnect(); print STDERR "Exit the database\n"; ######################################## ######################################## 1; __END__
