Open Source im professionellen Einsatz

Perl-Skript sichert Chat-Protokolle auf IMAP-Server

Gesprächsprotokolle

Michael Schilli

Wer nicht nur E-Mails auf dem IMAP-Server sichern, ordnen und durchsuchen möchte, sondern auch Konversationen via Instant Messaging, der tut dies am besten mit dem hier vorgestellten Perl-Skript.

E-Mails auf einem IMAP-Server statt über einen POP-Mailclient auf dem lokalen PC zu speichern, hat den Vorteil, auch von unterwegs Post mit gerade benötigten Informationen abrufen zu können. Wer allerdings diese Informationen nicht per E-Mail, sondern via Chat austauscht, der verliert sie, sobald die Konversation beendet ist.

Viele Messaging-Clients, zum Beispiel der Alleskönner Gaim bieten deshalb Logging an. Damit schreibt der Client alle Nachrichten auf der Festplatte mit. Aber oft genug sucht der Korrespondent eine per Chat ausgetauschten URL gerade dann verzweifelt, wenn er an einem anderen Rechner sitzt.

Sicherheitsbedenken

Hemmungslose Praktiker legen die Logdaten der Chats auf einem öffentlich erreichbaren Server ab und statten diesen mit allerlei Suchfunktionen aus. Dann allerdings stellt sich die Frage nach der Sicherheit der Daten vor unbefugtem Zugriff. Zwar tauscht niemand, der einigermaßen bei Verstand ist, vertrauliche Informationen über ungesicherte Chat-Kanäle aus, aber auch die private Konversation sollte privat bleiben. Wenn jedoch eine Sicherheitslücke im frei zugänglichen Server die Chats raussickern ließe, wäre das ähnlich peinlich, als wenn private E-Mails ans Licht der Öffentlichkeit gelangten.

Da es für E-Mail bereits einen bewährten und relativ sicheren Aufbewahrungsort gibt, nämlich den IMAP-Server, liegt es nahe, die Logdaten des Messaging-Clients ebenfalls dort einzuspeisen. Mit Hilfe des Menüs »Preferences | Logging« lässt sich Gaim schnell zum Mitschreiben überreden. Als Format wähle ich »Plain« (siehe Abbildung 1), weil ich ein Dinosaurier bin, der noch mit Pine als E-Mail-Client arbeitet und HTML-E-Mails für unnütz und gefährlich hält. Die Check-Buttons »Log all instant messages« und »Log all chats« regeln das Logging für normale Konversationen und Gruppenchats.

Abbildung 1: Gaim wird im Menü »Preferences« zum Mitprotokollieren der Chats konfiguriert. EInzelgespräche und Gruppenchats lassen sich mitschreiben.

Gut sortierte Ablage

Nach der Aktivierung legt Gaim selbstständig für jede Konversation eine separate Textdatei unter »~/.gaim/logs« an, und zwar in den Gaim-Versionen 1.x unter dem Pfad »Provider/Sender/Empfänger/*.txt«. Unterhalte ich mich als lokaler User zum Beispiel am 28. März 2007 kurz vor 10 Uhr unter dem Benutzernamen »mikeschilli« über das Yahoo-Messenger-Protokoll mit dem Partner »randomperlhacker«, liegt die Logdatei entsprechend unter »~/.gaim/logs/yahoo/mikeschilli/randomperlhacker/2007-03-28.095243.txt« vor. Die Konversation ist in Abbildung 2, der Inhalt der zugehörigen Logdatei dagegen in Abbildung 3 zu sehen.

Abbildung 2: Eine Konversation mit Gaim ...

Abbildung 3: ... erzeugt die entsprechende Logdatei.

Im Betrieb ruft der Daemon »gaim2imap« (Listing 1) die Funktion »update()« auf, bearbeitet alle neu gefundenen Logdateien und legt sich für eine voreingestellte Zeit schlafen. Eine Stunde (3600 Sekunden) ist dafür in der Variablen »$sleep« definiert.

Listing 1: »gaim2imap«
001 #!/usr/bin/perl -w 002 use strict; 003 use Gaim::Log::Parser 0.04; 004 use Gaim::Log::Finder; 005 use Sysadm::Install 0.23 qw(:all); 006 use Lingua::StopWords; 007 use Text::Language::Guess; 008 use Log::Log4perl qw(:easy); 009 use Text::Wrap qw(fill $columns); 010 use URI::Find; 011 use IMAP::Client; 012 use DateTime::Format::Mail; 013 014 my $mailbox = "im_mailbox"; 015 my $tzone = "America/Los_Angeles"; 016 my $min_age = 3600; 017 my $sleep = 3600; 018 019 my %im_stopwords = map { $_ => 1 } qw( 020 maybe thanks thx doesn hey put already 021 said say would can could haha hehe see 022 well think like heh now many lol doh ); 023 024 Log::Log4perl->easy_init({ 025 level => $DEBUG, category => "main", 026 file => ">>$ENV{HOME}/.gaim2imap.log" 027 }); 028 029 my $PW = password_read("password: "); 030 031 my $pid = fork(); 032 die "fork failed" if ! defined $pid; 033 exit 0 if $pid; 034 035 dbmopen my %SEEN, 036 "$ENV{HOME}/.gaim/.seen", 0644 or 037 LOGDIE "Cannot open dbm file ($!)"; 038 039 $SIG{TERM} = sub { INFO "Exiting"; 040 dbmclose %SEEN; 041 exit 0; 042 }; 043 044 while(1) { 045 update(); 046 INFO "Sleeping $sleep secs"; 047 sleep $sleep; 048 } 049 050 ########################################### 051 sub update { 052 ########################################### 053 DEBUG "Connecting to IMAP server"; 054 055 my $imap = new IMAP::Client(); 056 $imap->onfail('ABORT'); 057 $imap->connect(PeerAddr => 'localhost', 058 ConnectMethod => 'PLAIN'); 059 060 my $u = getpwuid $>; 061 $imap->authenticate($u, $PW); 062 063 my $finder = Gaim::Log::Finder->new( 064 callback => sub { 065 my($self, $file, $protocol, 066 $from, $to) = @_; 067 068 return 1 if $from eq $to; 069 070 my $mtime = (stat $file)[9]; 071 my $age = time() - $mtime; 072 073 return 1 if $SEEN{$file} and 074 $SEEN{$file} == $mtime; 075 076 if($age < $min_age) { 077 INFO "$file: Too recent ($age)"; 078 return 1; 079 } 080 081 $SEEN{$file} = $mtime; 082 INFO "Processing log file: $file"; 083 my($subject, $formatted, $epoch) = 084 chat_process($file); 085 086 imap_add($imap, $mailbox, $epoch, 087 "$to@gaim", "", $subject, 088 $formatted); 089 }); 090 091 $finder->find(); 092 } 093 094 ########################################### 095 sub chat_process { 096 ########################################### 097 my($file) = @_; 098 099 my $parser = Gaim::Log::Parser->new( 100 file => $file, 101 ); 102 # Search+delete URL processor 103 my $urifind = URI::Find->new(sub {""}); 104 105 my $text = ""; 106 my $formatted = ""; 107 my $urifound; 108 $Text::Wrap::columns = 70; 109 110 while(my $m = $parser->next_message()) { 111 my $content = $m->content(); 112 $content =~ s/n+/ /g; 113 $formatted .= fill("", " ", 114 nice_time($m->date()) . " " . 115 $m->from() . ": " . $content) . "nn"; 116 117 $urifound = 118 $urifind->find($content); 119 $text .= " " . $content; 120 } 121 122 my $guesser = Text::Language::Guess-> 123 new(languages => ['en', 'de']); 124 125 my $lang = 126 $guesser->language_guess_string($text); 127 128 $lang = 'en' unless $lang; 129 DEBUG "Guessed language: $langn"; 130 131 my $stopwords = 132 Lingua::StopWords::getStopWords($lang); 133 134 my %words; 135 136 while($text =~ /b(w+)b/g) { 137 my $word = lc($1); 138 next if $stopwords->{$word}; 139 next if $word =~ /^d+$/; 140 next if length($word) <= 2; 141 next if exists $im_stopwords{$word}; 142 $words{$word}++; 143 $words{$word} += 3 if length $word > 6; 144 } 145 146 my @weighted_words = sort { 147 $words{$b} <=> $words{$a} 148 } keys %words; 149 150 my $subj = ($urifound ? 'L' : ""); 151 my $char = ""; 152 153 while(@weighted_words and length($subj) + 154 length($char . 155 $weighted_words[0]) <= 70) { 156 $subj .= $char . shift @weighted_words; 157 $char = ", "; 158 } 159 160 return($subj, $formatted, 161 $parser->{dt}->epoch()); 162 } 163 164 ########################################### 165 sub imap_add { 166 ########################################### 167 my($imap, $mailbox, $date, 168 $from, $to, $subject, $text) = @_; 169 170 $date = 171 DateTime::Format::Mail->format_datetime( 172 DateTime->from_epoch( 173 epoch => $date, 174 time_zone => $tzone)); 175 176 my $message = "Date: $daten" . 177 "From: $fromn" . 178 "To: $ton" . 179 "Subject: $subjectnn$text"; 180 181 my $fl = $imap->buildflaglist(); 182 $imap->append($mailbox, $message, $fl); 183 }

Listing 1:
»gaim2imap«

001 #!/usr/bin/perl -w
002 use strict;
003 use Gaim::Log::Parser 0.04;
004 use Gaim::Log::Finder;
005 use Sysadm::Install 0.23 qw(:all);
006 use Lingua::StopWords;
007 use Text::Language::Guess;
008 use Log::Log4perl qw(:easy);
009 use Text::Wrap qw(fill $columns);
010 use URI::Find;
011 use IMAP::Client;
012 use DateTime::Format::Mail;
013 
014 my $mailbox = "im_mailbox";
015 my $tzone  = "America/Los_Angeles";
016 my $min_age = 3600;
017 my $sleep  = 3600;
018 
019 my %im_stopwords = map { $_ => 1 } qw(
020 maybe thanks thx doesn hey put already
021 said say would can could haha hehe see
022 well think like heh now many lol doh );
023 
024 Log::Log4perl->easy_init({
025  level => $DEBUG, category => "main",
026  file => ">>$ENV{HOME}/.gaim2imap.log"
027 });
028 
029 my $PW = password_read("password: ");
030 
031 my $pid = fork();
032 die "fork failed" if ! defined $pid;
033 exit 0 if $pid;
034 
035 dbmopen my %SEEN,
036     "$ENV{HOME}/.gaim/.seen", 0644 or
037    LOGDIE "Cannot open dbm file ($!)";
038 
039 $SIG{TERM} = sub { INFO "Exiting";
040   dbmclose %SEEN;
041   exit 0;
042 };
043 
044 while(1) {
045   update();
046   INFO "Sleeping $sleep secs";
047   sleep $sleep;
048 }
049 
050 ###########################################
051 sub update {
052 ###########################################
053  DEBUG "Connecting to IMAP server";
054 
055  my $imap = new IMAP::Client();
056  $imap->onfail('ABORT');
057  $imap->connect(PeerAddr => 'localhost',
058    ConnectMethod => 'PLAIN');
059 
060  my $u = getpwuid $>;
061  $imap->authenticate($u, $PW);
062 
063  my $finder = Gaim::Log::Finder->new(
064   callback => sub {
065    my($self, $file, $protocol,
066      $from, $to) = @_;
067 
068    return 1 if $from eq $to;
069 
070    my $mtime = (stat $file)[9];
071    my $age = time() - $mtime;
072 
073    return 1 if $SEEN{$file} and
074          $SEEN{$file} == $mtime;
075 
076    if($age < $min_age) {
077      INFO "$file: Too recent ($age)";
078      return 1;
079    }
080 
081    $SEEN{$file} = $mtime;
082    INFO "Processing log file: $file";
083    my($subject, $formatted, $epoch) =
084           chat_process($file);
085 
086    imap_add($imap, $mailbox, $epoch,
087         "$to@gaim", "", $subject,
088         $formatted);
089  });
090 
091  $finder->find();
092 }
093 
094 ###########################################
095 sub chat_process {
096 ###########################################
097  my($file) = @_;
098 
099  my $parser = Gaim::Log::Parser->new(
100   file => $file,
101  );
102    # Search+delete URL processor
103  my $urifind = URI::Find->new(sub {""});
104 
105  my $text   = "";
106  my $formatted = "";
107  my $urifound;
108  $Text::Wrap::columns = 70;
109 
110  while(my $m = $parser->next_message()) {
111   my $content = $m->content();
112   $content =~ s/n+/ /g;
113   $formatted .= fill("", " ",
114    nice_time($m->date()) . " " .
115    $m->from() . ": " . $content) . "nn";
116 
117   $urifound =
118     $urifind->find($content);
119   $text .= " " . $content;
120  }
121 
122  my $guesser = Text::Language::Guess->
123       new(languages => ['en', 'de']);
124 
125  my $lang =
126   $guesser->language_guess_string($text);
127 
128  $lang = 'en' unless $lang;
129  DEBUG "Guessed language: $langn";
130 
131  my $stopwords =
132   Lingua::StopWords::getStopWords($lang);
133 
134  my %words;
135 
136  while($text =~ /b(w+)b/g) {
137   my $word = lc($1);
138   next if $stopwords->{$word};
139   next if $word =~ /^d+$/;
140   next if length($word) <= 2;
141   next if exists $im_stopwords{$word};
142   $words{$word}++;
143   $words{$word} += 3 if length $word > 6;
144  }
145 
146  my @weighted_words = sort {
147   $words{$b} <=> $words{$a}
148  } keys %words;
149 
150  my $subj = ($urifound ? '*L*' : "");
151  my $char = "";
152 
153  while(@weighted_words and length($subj) +
154    length($char .
155            $weighted_words[0]) <= 70) {
156   $subj .= $char . shift @weighted_words;
157   $char = ", ";
158  }
159 
160  return($subj, $formatted,
161      $parser->{dt}->epoch());
162 }
163 
164 ###########################################
165 sub imap_add {
166 ###########################################
167  my($imap, $mailbox, $date,
168    $from, $to, $subject, $text) = @_;
169 
170  $date =
171   DateTime::Format::Mail->format_datetime(
172    DateTime->from_epoch(
173      epoch => $date,
174      time_zone => $tzone));
175 
176  my $message = "Date: $daten" .
177   "From: $fromn" .
178   "To: $ton" .
179   "Subject: $subjectnn$text";
180 
181  my $fl = $imap->buildflaglist();
182  $imap->append($mailbox, $message, $fl);
183 }