Open Source im professionellen Einsatz
Linux-Magazin 12/2006
© photocase.com

© photocase.com

Perlskript wartet für Anrufer auf eine freie Leitung

Kleiner Lauschangriff

Ist auf der heimischen Telefonnummer mal wieder kein Durchkommen, lauscht ein Skript an der Leitung und signalisiert dem Wartenden via Web, wann er erneut anrufen kann.

1293

Was tun, wenn man zu Hause anrufen will, dort aber jemand mal wieder mit einem Marathongespräch die Leitung blockiert? In den USA gibt es zwar einen Service namens Call Waiting, der dem Dauertelefonierer durch ein Piepzeichen anzeigt, dass ein Anrufer versucht durchzukommen. Doch dieser Service kostet extra und nervt leicht, deshalb habe ich neulich mit Hilfe eines kleinen Telefonverstärkers von Radio Shack (Abbildung 1 und [1]) eine kleine Applikation gebastelt.

Abbildung 1: Ein Telefonverstärker leitet das Telefonsignal an die Soundkarte des Rechners, die es über das Device »/dev/dsp« weitergibt.

Die so genannte Smart Phone Recorder Control greift das Signal aus der Telefonleitung ab und leitet es per Klinkenstecker an den Mikrofoneingang der Soundkarte meines Linux-Rechners weiter. Das Tonsignal ist dann unter Linux über das Device »/dev/dsp« verfügbar und das Perl-Modul »Audio::DSP« vom CPAN liest es ein. Mit ein paar heuristischen Tricks bestimmt das Skript, ob jemand gerade ein Gespräch führt. Falls ja, bleibt es am Ball, bis sich nichts mehr regt, und meldet das Gesprächsende anschließend über ein verstecktes CGI-Skript auf einer Webseite.

Schläfer aus der Ferne aktivieren

Im Ruhezustand schläft das Skript »phonewatch« (Listing 1) auf dem heimischen Linux-Rechner und sieht alle 60 Sekunden auf der Webseite nach, ob jemand via CGI-Skript per Mausklick den Status »check« eingestellt hat (siehe Abbildung 3, links). Ist dem so, erwacht das Skript und fängt sofort damit an, Daten aus der Telefonleitung zu sammeln. Auf der Webseite zeigt es währenddessen den Status »busy« an und frischt die Seitendarstellung alle 60 Sekunden im Browser auf.

Abbildung 2: Eine Webseite aktiviert das Skript auf dem Linux-Rechner und zeigt den Status des Telefongesprächs an.

Abbildung 3: Links: Das CGI-Skript läuft im Idle-Modus, der Lauscher wartet auf Aktivität. Rechts: Der Lauscher hat bestätigt, dass die Telefonleitung belegt ist, und zeigt »busy« an. Wird der Hörer aufgelegt, springt der Status wieder auf »idle«.

Listing 1:
»phonewatch«

01 #!/usr/bin/perl -w
02 
03 use strict;
04 use Audio::DSP;
05 use Log::Log4perl qw(:easy);
06 use SoundActivity;
07 use LWP::Simple;
08 
09 Log::Log4perl->easy_init({
10   file => "/tmp/phonewatch.log",
11   level => $INFO,
12 });
13 
14 my $IN_USE_POLL =  10;
15 my $IDLE_POLL   =  60;
16 my $STATUS_URL  =
17      'https://u:p@_foo.com/phonewatch.cgi';
18 my $SAMPLE_RATE = 1024;
19 
20 INFO "Starting up";
21 
22 while(1) {
23   my $state = state();
24 
25   if(! defined $state) {
26     DEBUG "Fetch failed";
27     sleep $IDLE_POLL;
28     next;
29   }
30 
31   DEBUG "web site state: $state";
32 
33   if($state eq "idle") {
34     DEBUG "Staying idle";
35     sleep $IDLE_POLL;
36     next;
37   }
38 
39   INFO "Monitor requested";
40   state("busy");
41   poll_busy();
42   state("idle");
43 }
44 
45 ###########################################
46 sub poll_busy{
47 ###########################################
48 
49   my $dsp = new Audio::DSP(
50     buffer   => 1024,
51     channels => 1,
52     format   => 8,
53     rate     => $SAMPLE_RATE,
54   );
55 
56   $dsp->init() or die $dsp->errstr();
57 
58   my $act = SoundActivity->new();
59 
60   while(1) {
61     DEBUG "Reading DSP";
62     $dsp->read() or die $dsp->errstr();
63 
64     $act->sample_add( $dsp->data() );
65     $dsp->clear();
66 
67     if(! $act->is_active()) {
68         INFO "Hangup detected";
69         $dsp->close();
70         return 1;
71     }
72     sleep $IN_USE_POLL;
73   }
74 }
75 
76 ###########################################
77 sub state {
78 ###########################################
79   my($value) = @_;
80 
81   my $url = $STATUS_URL;
82   $url .= "?state=$value" if $value;
83   DEBUG "Fetching $url";
84   my $content = get $url;
85   if($content =~ m#<b>(.*?)</b>#) {
86       return $1;
87   }
88 }

Wird der Hörer aufgelegt, bekommt »phonewatch« dies mit und stellt die Anzeige des CGI-Skripts auf »idle« zurück. Die Endlosschleife ab Zeile 22 holt den Status von der Webseite. Lautet der »idle«, legt sich das Skript » Sekunden schlafen. Die Funktion »state()« dient zur Abfrage des aktuellen Status, kann aber auch (wenn ihr ein Parameter überreicht wird) einen neuen Status setzen. Beides erledigt sie mit einem »get«-Aufruf aus dem Modul »LWP::Simple«, das eine Webseite per URL abruft. Aus dem zurückkommenden Seiteninhalt filtert sie den Skriptstatus aus dem »<b>«-Tag heraus.

Fischen im Audio

Der Konstruktor der Klasse »Audio::DSP« erwartet vier Parameter: die Länge des zu füllenden Datenpuffers (1024), die Anzahl der Kanäle (hier 1, da Mono), das Format der abgegriffenen Datenpunkte (unsigned 8 Bit) und die Samplingrate (1024 Samples pro Sekunde). Digitale Audiodaten liegen als Zahlenwerte vor, die ein Wandler n-mal pro Sekunde aus dem analogen Tonsignal abgreift.

Diese Samplingrate n muss doppelt so hoch sein wie die höchste abzugreifende Audiofrequenz. Bei Hi-Fi-Qualität (mit knapp über 20 kHz) hat sie also mehr als 40000 Samples pro Sekunde zu liefern. Da es in diesem Fall aber nicht um einen großen Lauschangriff geht, sondern nur Aktivität festzustellen ist, reichen 1024 Samples pro Sekunde völlig aus. Mehr zum Thema "Digitales Audio" findet sich in [2].

In einer Sekunde füllt sich so der Puffer bis zum Rand und das Skript füttert ihn an die Methode »sample_add()« des Moduls »SoundActivity.pm« (Listing 2). Die Methode entpackt die 8-Bit-Werte mit »unpack("C")« und ermittelt deren statistische Standardabweichung.

Listing 2:
»SoundActivity.pm«

01 ###########################################
02 # Mike Schilli, 2006 (m@perlmeister.com)
03 ###########################################
04 package SoundActivity;
05 ###########################################
06 use strict;
07 use warnings;
08 use Statistics::Basic::StdDev;
09 use Log::Log4perl qw(:easy);
10 
11 ###########################################
12 sub new {
13 ###########################################
14   my($class, %options) = @_;
15 
16   my $self = {
17       min_hist       => 5,
18       max_hist       => 5,
19       history        => [],
20       sdev_threshold => 0.01,
21       %options,
22   };
23 
24   bless $self, $class;
25 }
26 
27 ###########################################
28 sub sample_add {
29 ###########################################
30   my($self, $data) = @_;
31 
32   my $len     = length($data);
33   my @samples = unpack("C$len", $data);
34 
35   my $sdev = $self->sdev(@samples);
36 
37   my $h = $self->{history};
38   push @$h, $sdev;
39   shift @$h if @$h > $self->{max_hist};
40   DEBUG "History: [", join(', ', @$h), "]";
41 }
42 
43 ###########################################
44 sub is_active {
45 ###########################################
46   my($self) = @_;
47 
48   if(@{$self->{history}} <
49      $self->{min_hist}) {
50       DEBUG "Not enough samples yet";
51       return 1;
52   }
53 
54   my $sdev = $self->sdev($self->{history});
55   DEBUG "sdev=$sdev";
56 
57   if($sdev < $self->{sdev_threshold}) {
58       DEBUG "sdev too low ($sdev)";
59       return 0;
60   }
61 
62   return 1;
63 }
64 
65 ###########################################
66 sub sdev {
67 ###########################################
68   my($self, $aref) = @_;
69 
70   return sprintf "%.2f",
71          Statistics::Basic::StdDev->
72               new($aref)->query;
73 }
74 
75 1;

Listing 3:
»phonewatch.cgi«

01 #!/usr/bin/perl -w
02 use strict;
03 use CGI qw(:all);
04 use DB_File;
05 use Template;
06
07 my %states = (
08   idle  => 'green',
09   check => 'yellow',
10   busy  => 'red',
11 );
12
13 tie my %store, "DB_File",
14   "data/phonewatch.dat" or die $!;
15
16 $store{state} = "idle" unless
17     defined $store{state};
18
19 print header();
20
21 my $new = param('state');
22 if($new and exists $states{$new}) {
23     $store{state} = $new;
24 }
25
26 my $tpl = Template->new();
27 $tpl->process( join('', <DATA>),
28   { bgcolor => $states{$store{state}},
29     state   => $store{state},
30     self    => url(),
31   }) or die $tpl->error;
32
33 ###########################################
34 __DATA__
35 <HEAD>
36   <META HTTP-EQUIV="Refresh"
37         CONTENT="30;
38             URL=[% self %]">
39 </HEAD>
40 <BODY>
41   <H1>Phone Monitor</H1>
42   <TABLE CELLPADDING=5>
43     <TR>
44       <TD BGCOLOR="[% bgcolor %]">
45         Status: <b>[% state %]</b>
46       </TD>
47       [% IF state == "idle" %]
48       <TD>
49         <A HREF="[% self %]?state=check">
50         check</A>
51       </TD>
52       [% END %]
53     </TR>
54   </TABLE>
55 </BODY>

Aus einer toten Telefonleitung kann der Verstärker kein Signal auslesen, nur etwas Rauschen kommt am Mikrofoneingang der Soundkarte an. Die Sample-Werte, deren Wertebereich sich von 0 bis 255 erstreckt, nehmen in diesem Ruhezustand alle etwa den Wert 127 an und schwanken manchmal um 1 nach oben oder unten. Die Standardabweichung lag im Experiment typischerweise lediglich bei etwa 0,5.

In »SoundActivity.pm« (Listing 2) errechnet die Methode »sdev« ab Zeile 66 die auf zwei Nachkommastellen gerundete Standardabweichung der Elemente eines per Referenz übergebenen Array. »sdev()« nutzt für die nötige einfache Arithmetik das CPAN-Modul »Statistics::Basic::StdDev«.

Das Skript »phonewatch« werkelt im aktiven Modus in der Funktion »poll_busy()« herum. Es führt jeweils eine Sekundenmessung an der Soundkarte durch, wartet 10 Sekunden und ermittelt dann den nächsten Messpunkt. Die gesammelten Standardabweichungen aus fünf Messpunkten sehen bei einem Telefongespräch etwa folgendermaßen aus: »[0.64, 0.78, 0.73, 0.89, 0.86]«

Linux-Magazin kaufen

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

Deutschland

Ähnliche Artikel

  • Ich glotz' TV

    Nina Hagens Medien-Nutzungsverhalten zu kopieren ist für einen Auslandsdeutschen gar nicht einfach. Doch ein Internet-Fernsehportal, die abgekupferte Technik eines Geräts und Perl verhelfen Exilanten sogar zu zeitversetztem Pantoffelkino. Hier Gebliebene haben natürlich genauso viel Spaß.

  • I2C-Bus

    Standardisierte Protokolle und Schnittstellen bieten im Vergleich zu proprietären viele Vorteile. Einer davon: Sie sind deutlich günstiger. Das zeigt auch das Beispiel einer Automatisierung von Lichtern, Jalousien und der Alarmanlage mit Komponenten für den I2C-Bus in diesem Artikel.

  • Netz-Journal

    Was der Rechner im eigenen Netz treibt, offenbart ein Aufruf von »netstat«. Mit ein paar Perl-Modulen lässt sich daraus ein Tool entwickeln, das die Daten dynamisch anzeigt, ganz nach dem Vorbild von Top.

  • Lesezeichen-Zentrale

    Ob im Büro, zu Hause oder mit dem Laptop im Hotelzimmer: Wer oft durch das World Wide Web surft, will seine Bookmarks immer abrufbar haben. Sie auf allen Rechnern synchron halten ist sehr umständlich. Ein CGI-Skript hilft und macht die persönliche Bookmark-Liste überall verfügbar.

  • Wer A sagt, darf nicht B sagen

    Catalyst ist das Ruby on Rails der Perl-Welt: Bei der Entwicklung von Webapplikationen - beispielsweise eines Quiz - bietet das MVC-Framework enormen Komfort und eine saubere Trennung der Komponenten.

comments powered by Disqus

Ausgabe 09/2017

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