Open Source im professionellen Einsatz
Linux-Magazin 06/2007
© Frankenmarco, photocase.com

© Frankenmarco, photocase.com

Perl-Skript sichert Chat-Protokolle auf IMAP-Server

Gesprächsprotokolle

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.

1002

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 }

Linux-Magazin kaufen

Einzelne Ausgabe
 
Abonnements
 
TABLET & SMARTPHONE APPS
Bald erhältlich
Get it on Google Play

Deutschland

Ähnliche Artikel

  • IMAP-Server Dovecot 1.2 mit neuen Plugins

    Der freie IMAP- und POP3-Server Dovecot ist in Version 1.2 erhältlich. Er setzt weitere Extensions des IMAP-Protokolls um und bringt neue Plugins mit.

  • Auf der Teststrecke

    Was leisten moderne IMAP-Server? Wo liegen ihre Grenzen, wo die Unterschiede? Welche Faktoren beeinflussen die Leistung? Das Linux-Magazin hat die vier besten in der Businessklasse getestet.

  • Mailvertreter

    Skalierbarkeit hat sich zu einer Kernfrage für Linux-Mailserver entwickelt. IMAP-Proxies wie Perdition, Imapproxy oder Cyrus Aggregator helfen die E-Mails auf mehrere IMAP-Backends zu verteilen, ohne dabei einen Cluster einrichten zu müssen.

  • Lemonade für unterwegs

    IMAP und Co sind prima Protokolle für zuhause. Unterwegs auf Kleingeräten verwendet, fallen geringe Bandbreiten, knappe Prozessorleistungen und unterbrochene Verbindungen plötzlich ins Gewicht. Die Lemonade-Arbeitsgruppe steuert mit einem eigenen RFC gegen.

  • Vier Musketiere

    Ehrenhaft und unschuldig beteuern alle modernen E-Mail-Programme IMAP zu beherrschen. Von den süßen Versprechungen bleiben bei genauem Hinschauen jedoch nur noch einzelne Facetten übrig.

comments powered by Disqus

Ausgabe 09/2016

Digitale Ausgabe: Preis € 6,40
(inkl. 19% MwSt.)

Artikelserien und interessante Workshops aus dem Magazin können Sie hier als Bundle erwerben.