Ellenlange URLs lassen sich nur schwer in Zeitschriftenartikeln drucken oder per Email versenden. Ein CGI-Skript auf einem öffentlichen Server erlaubt drastische Abkürzungen.
Beim Lesen des neuesten Cryptograms, dem monatlichen Rundbrief des
Sicherheits-Superhelden Bruce Schneier [2], fiel mir auf, dass die sonst
eher länglichen URLs zu diversen Literaturverweisen ungewohnt kurz
ausfielen: Sie verwiesen alle auf http://tinyurl.com und endeten
in kryptischen Kürzeln.
Alles klar: tinyurl.com bietet einen
(kostenlosen) Service an, der lange URLs speichert und durchnumeriert.
Verweist jemand auf so einen URL, sieht tinyurl.com in seiner
Datenbank nach und führt einen redirect auf den Ziel-URL aus. So
registrierte ich neulich
http://tinyurl.com/kowv
das auf den neuesten USA-Rundbrief unter
http://perlmeister.com/rundbrief.archiv/20030801
verweist. Praktisch!
Das Ganze lässt sich auch ganz simpel in Perl implementieren: Ein
persistenter Hash führt eindeutige Kürzel als Schlüssel und
registrierte URLs als Werte. Statt dezimaler Zahlen
werden Gebilde aus Kleinbuchstaben und Zahlen eingesetzt.
Wir landen wir im Zahlensystem zur Basis 36 (26 Buchstaben plus 10
Ziffern) und verbrauchen schlagartig
für eine Million nur noch vier Zeichen: 4c92 repräsentiert die
dezimale Zahl 1.000.000 im 36er-System.
Eine vierstellige Zahl zur Basis 36 kann insgesamt
36^4 = 1.679.616
verschiedene Werte abspeichern -- das sollte für's Erste ausreichen.
Listing u (wir sparen wo's geht) zeigt ein CGI-Skript, das
tinyurl.com nachbildet.
| |
| Abbildung 1: Der Kompressor nimmt einen neuen URL entgegen, speichert ihn in seiner Datenbank und gibt dessen Kurzform aus. |
Das aufs offene Internet gestellte Skript soll natürlich nicht dem allerersten Schlimmfinger in die Hände fallen, deswegen einige Sicherheitsvorkehrungen:
Die CGI-Funktionalität erledigt Lincoln Steins CGI-Modul
und dessen CGI::Carp-Ableger, der mit dem eingestellten
fatalsToBrowser-Tag jegliche Perl-Exceptions abfängt und
zu Debugging-Zwecken im Browser darstellt.
Sieht das Skript keinen url-Parameter, zeigt es im Browser ein
Formular zur Eingabe einer neuen URL an, dessen Submit-Button sie
als Parameter url wieder zum Skript auf dem Server schickt.
Der rechnet dann eine abgekürzte URL aus und speichert die Zuordnung
der Abkürzung zur vollen URL in seiner Mini-Datenbank ab, falls sie
dort nicht eh schon steht. Die abgekürzten URLs sind von der Form
http://server.com/cgi/u/xxxx
und senden die URL-Abkürzung xxxx angehängt an den Pfad zum Skript
u, dessen CGI-Umgebung sie in der Variablen $ENV{PATH_INFO}
zugänglich macht. Sieht das Skript eine derartige Anfrage, holt es den
zugehörigen langen URL aus der Datenbank und sendet einen redirect(),
was den Browser nahtlos zur entsprechenden Website verzweigen lässt.
Komfortables Logging mit DEBUG(), INFO() und LOGDIE()-Macros besorgt wie
immer Log::Log4perl qw(:easy)
das heute mal mit einem FileRotate-Appender
aus dem Log::Dispatch-Fundus konfiguriert wird. size=1000000 legt
ein Megabyte maximale Größe fest, und max=1 bestimmt, dass der
FileRotate-Appender
ein volles Logfile shrink.log nach shrink.log.1 abrollt,
wenn shrink.log 1 Megabyte überschreitet, aber keine
weiteren Backups vornimmt, damit sich zu jeder Zeit höchstens
2 Megabytes an Logdateien auf der Platte befinden.
Der mittels tie() an die Datei /tmp/shrink.dat gebundene
persistente Hash URLS speichert in u nicht wie üblich eine
einzelne Key/Value-Zuordnung, sondern gleich drei! Deswegen erhalten die
Schlüssel jeweils einen Präfix:
by_shrink/),
die URL zu einer Abkürzung (Präfix by_url/)
die nächste zu vergebende Abkürzung (next/)
An einigen Stellen soll das Skript einfach aufhören: Schnell noch vom
persistenten Hash abkoppeln und dann das Programm beenden. Mit exit()
auszusteigen, wäre schlechter Stil, da dies
in Umgebungen wie mod_perl Probleme verursacht. return() geht auch nur,
wenn perl gerade eine Subroutine ausführt. Schließlich kam das gute alte
goto zum Einsatz, das echte Programmierer (im Gegensatz zu sog.
Quiche-Fressern) laut [3] bekanntlich nicht fürchten.
An den paar Abbruchstellen im Skript springt
goto einfach zum weiter unten definierten Label END.
Um die Anzahl der URLs pro Tag, die Benutzer pro IP-Adresse einspeichern
können, zu limitieren, kommt ein
File-Cache mit einstellbarem Verfallsdatum zum Einsatz. Das schlaue
Cache::Cache-Modul bietet eine Schnittstelle, die mit set() neue Einträge
setzt und sie mit get() wieder holt. Die abgeleitete Klasse
Cache::FileCache implementiert diese Funktionalität als Hierarchie von
Dateien auf der Platte.
Das Skript speichert pro IP einen Zähler und erhöht diesen mit jeder von dieser Internet-Adresse angeforderten URL. Ist der Höchststand erreicht, blockt das Skript weitere Anträge zu neuen URLs, liefert aber weiterhin die Kürzel zu bereits definierten aus. Nach Ablauf eines Tages 'vergisst' File::Cache aber die vorgenommenen Einträge und der Zählvorgang beginnt von vorn. Mit diesem simplen Verfahren akzeptieren wir allerdings einen kleinen Fehler: Schlimmstenfalls wird so eine IP für einen Tag blockiert, die stetig aber innerhalb der Tagesgrenzen neue URLs anforderte.
Die IP-Adresse des Clients stellt die CGI-Umgebung des Webservers
zuverlässig in der Variablen
$ENV{REMOTE_ADDR} zur Verfügung.
Von der Kommandozeile aus aufgerufen setzt das Skript die
Variable $ENV{REMOTE_ADDR} allerdings nicht. Darum setzt
Zeile 130 anstelle der IP-Adresse einfach den String NO_IP.
Die Option default_expires_in des Cache::FileCache-Konstruktors
gibt die Zeitspanne in Sekunden nach
dem letzten set() an, ab der der Cache sich einfach nicht mehr an den
Eintrag erinnern kann. auto_purge_on_get gibt an, dass der Cache
automatisch bei jedem get()-Aufruf bereits verfallene Einträge aufspürt
und von der Platte putzt -- das stellt sicher, dass der Cache nicht
unendlich mit legitim operierenden IP-Adressen anwächst.
Die ab Zeile 109 definierte Funktion base36 wandelt Dezimalzahlen platzsparend zur Basis 36 um. Wie geht das? Eine Zahl im Zehner-System baut sich wie folgt auf:
a*1 + b*10 + c*10*10 + ...
wobei cba die Ziffern der Zahl darstellen. 156 stellt sich als
6*1 + 5*10 + 1*10*10
dar. Im 36er-System hingegen gilt stattdessen
a*1 + b*36 + b*36*36 +...
und folgender Algorithmus wandelt eine Dezimalzahl d dahin um:
``Bestimme den Rest der Division d/36 (also d modulo 36 oder d % 36).
Dies ergibt das letzte Zeichen der Zahl zur Basis 36. Dann teile
die umzuwandelnde Zahl durch 36, nimm den ganzzahligen Anteil des
Ergebnisses und fahre fort, um die nächste Zeichen (von rechts
nach links) der Zielzahl zu ermitteln.''
In der Funktion base36() kommen im Array @chars
zunächst alle gültigen Zeichen zu liegen: Die
Ziffern von 0 bis 9 und die Kleinbuchstaben von 'a' bis 'z'.
Die danach folgende for-Schleife ermittelt zunächst mit
my $b = @chars;
wegen des in skalaren Kontext gestellten Arrays @chars
dessen Länge in $b -- also die Anzahl der gültigen Zeichen,
36 im vorgestellten Fall. Mit $num % $b wird ermittelt, wieviel
als Rest übrigbleibt, wenn man die umzuwandelnde Zahl $num
durch die Zahl der verfügbaren Zeichen im 36er-System teilt --
also genau die letzte 'Ziffer' der umgewandelnden Zahl im Zielsystem.
Der Fortsetzungsteil der for-Schleife, $num /= $b,
führt wegen der vorher in base36() angeforderten Direktive
use integer;
mit $num und $b eine Division ohne Fließkommaanteil durch.
Der Ausdruck
$result .= $chars[$num % $b];
schnappt sich das richtige Zeichen aus dem 36er-Zeichensatz und
fügt es ans Ende des Strings in $result an -- die Zahl im
Zielsystem wird also verkehrt herum aufgebaut. Dies korrigiert
der Ausdruck
return scalar reverse $result;
am Ende, indem er den String in $result umdreht. Skalarer
Kontext ist notwendig, da reverse im List-Kontext
einfach eine ihr übergebene Liste umdreht und nicht die
Buchstaben eines Einzelwerts.
001 #!/usr/bin/perl
002 ###########################################
003 # Mike Schilli, 2003 (m@perlmeister.com)
004 ###########################################
005 use warnings;
006 use strict;
007 use Log::Log4perl qw(:easy);
008 use Cache::FileCache;
009
010 my $DB_FILE = "/tmp/shrinky.dat";
011 my $DB_MAX_SIZE = 10_000_000;
012 my $MAX_URL_LEN = 256;
013 my $REQS_PER_IP = 200;
014
015 Log::Log4perl->init(\ <<"EOT");
016 log4perl.logger = DEBUG, Rot
017 log4perl.appender.Rot=\\
018 Log::Dispatch::FileRotate
019 log4perl.appender.Rot.filename=\\
020 /tmp/shrink.log
021 log4perl.appender.Rot.layout=\\
022 PatternLayout
023 log4perl.appender.Rot.layout.\\
024 ConversionPattern=%d %m%n
025 log4perl.appender.Rot.mode=append
026 log4perl.appender.Rot.size=1000000
027 log4perl.appender.Rot.max=1
028 EOT
029
030 use CGI qw(:all);
031 use CGI::Carp qw(fatalsToBrowser);
032 use DB_File;
033
034 tie my %URLS, 'DB_File', $DB_FILE,
035 O_RDWR|O_CREAT, 0755 or
036 LOGDIE "tie failed: $!";
037
038 # First time initialization
039 $URLS{"next/"} ||= 1;
040
041 my $redir = "";
042
043 if(exists $ENV{PATH_INFO}) {
044 # Redirect requested
045 my $num = substr($ENV{PATH_INFO}, 1);
046 $redir = $URLS{"by_shrink/$num"} if
047 $num ne "_"
048 and exists $URLS{"by_shrink/$num"};
049 }
050
051 if($redir) {
052 print redirect($redir);
053 goto END;
054 }
055
056 print header();
057
058 if(my $url = param('url')) {
059
060 if(length $url > $MAX_URL_LEN) {
061 print "Sorry, URL too long.\n";
062 goto END;
063 }
064
065 my $surl;
066
067 # Does it already exist?
068 if(exists $URLS{"by_url/$url"}) {
069 DEBUG "$url exists already";
070 $surl = $URLS{"by_url/$url"};
071
072 } else {
073 if(-s $DB_FILE > $DB_MAX_SIZE) {
074 DEBUG "DB File maxed out " .
075 (-s $DB_FILE) . " > $DB_FILE";
076 print "Sorry, no more URLs.\n";
077 goto END;
078 }
079
080 if(rate_limit($ENV{REMOTE_ADDR})) {
081 print "Sorry, too many requests " .
082 "from this IP\n";
083 goto END;
084 }
085
086 # Register new URL
087 my $n = base36($URLS{"next/"}++);
088 INFO "$url: New shortcut: $n";
089 $surl = url() . "/$n";
090 $URLS{"by_shrink/$n"} = $url;
091 $URLS{"by_url/$url"} = $surl;
092 }
093 print a({href => $surl}, $surl);
094 }
095
096 # Accept user input
097 print h1("Add a URL"),
098 start_form(),
099 textfield(-size => 60,
100 -name => "url",
101 -default => "http://"),
102 submit(), end_form();
103
104 END:
105
106 untie %URLS;
107
108 ###########################################
109 sub base36 {
110 ###########################################
111 my ($num) = @_;
112
113 use integer;
114
115 my @chars = ('0'..'9', 'a'..'z');
116 my $result = "";
117
118 for(my $b=@chars; $num; $num/=$b) {
119 $result .= $chars[$num % $b];
120 }
121
122 return scalar reverse $result;
123 }
124
125 ###########################################
126 sub rate_limit {
127 ###########################################
128 my ($ip) = @_;
129
130 $ip = 'NO_IP' unless defined $ip;
131
132 INFO "Request from IP $ip";
133
134 my $cache = Cache::FileCache->new(
135 { default_expires_in => 3600*24,
136 auto_purge_on_get => 1,
137 }
138 );
139
140 my $count = $cache->get($ip);
141
142 if(defined $count and
143 $count >= $REQS_PER_IP) {
144 INFO "Rate-limiting IP $ip";
145 return 1;
146 }
147
148 $cache->set($ip, ++$count);
149
150 return 0;
151 }
Das Skript benötigt Log::Log4perl, Log::Dispach::FileRotate und
Cache::FileCache, alle sind vom CPAN erhältlich. Die Pfade zur Logdatei
(Zeile 20) und zur Datenbankdatei (Zeile 10) sind an die lokalen
Verhältnisse anzupassen und das Skript
ins cgi-bin-Verzeichnis eines Webservers zu verfrachten.
Wenn der Aufruf von der Kommandozeile funktioniert (auf Ausführungsrechte
und Schreibrechte für die Datenverzeichnisse achten!), sollte es
auch im Webbrowser klappen -- aber bitte auf die unterschiedliche User-ID
(meist nobody) achten. Staucht eure überlangen URLs zusammen,
kürzt gnadenlos!
 |
Michael Schilliarbeitet als Software-Engineer bei Yahoo! in Sunnyvale, Kalifornien. Er hat "Goto Perl 5" (deutsch) und "Perl Power" (englisch) für Addison-Wesley geschrieben und ist unter mschilli@perlmeister.com zu erreichen. Seine Homepage: http://perlmeister.com. |