! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences io.files io.launcher io.encodings.ascii
-io.streams.string http.client generalizations combinators
-math.parser math.vectors math.intervals interval-maps memoize
-csv accessors assocs strings math splitting grouping arrays ;
+USING: accessors arrays assocs combinators combinators.smart csv
+grouping http.client interval-maps io.encodings.ascii io.files
+io.files.temp io.launcher io.pathnames ip-parser kernel math
+math.parser memoize sequences strings ;
IN: geo-ip
-: db-path ( -- path ) "IpToCountry.csv" temp-file ;
+: db-path ( -- path ) "IpToCountry.csv" cache-file ;
-: db-url ( -- url ) "http://software77.net/cgi-bin/ip-country/geo-ip.pl?action=download" ;
+CONSTANT: db-url "http://software77.net/geo-ip/?DL=1"
: download-db ( -- path )
db-path dup exists? [
db-url over ".gz" append download-to
- { "gunzip" } over ".gz" append (normalize-path) suffix try-process
+ { "gunzip" } over ".gz" append absolute-path suffix try-process
] unless ;
TUPLE: ip-entry from to registry assigned city cntry country ;
: parse-ip-entry ( row -- ip-entry )
- 7 firstn {
- [ string>number ]
- [ string>number ]
- [ ]
- [ ]
- [ ]
- [ ]
- [ ]
- } spread ip-entry boa ;
+ [
+ {
+ [ string>number ]
+ [ string>number ]
+ [ ]
+ [ ]
+ [ ]
+ [ ]
+ [ ]
+ } spread
+ ] input<sequence ip-entry boa ;
MEMO: ip-db ( -- seq )
download-db ascii file-lines
- [ "#" head? not ] filter "\n" join <string-reader> csv
+ [ "#" head? ] reject "\n" join string>csv
[ parse-ip-entry ] map ;
: filter-overlaps ( alist -- alist' )
2 clump
[ first2 [ first second ] [ first first ] bi* < ] filter
- [ first ] map ;
+ keys ;
MEMO: ip-intervals ( -- interval-map )
ip-db [ [ [ from>> ] [ to>> ] bi 2array ] keep ] { } map>assoc
GENERIC: lookup-ip ( ip -- ip-entry )
-M: string lookup-ip
- "." split [ string>number ] map
- { HEX: 1000000 HEX: 10000 HEX: 100 HEX: 1 } v.
- lookup-ip ;
+M: string lookup-ip ipv4-aton lookup-ip ;
M: integer lookup-ip ip-intervals interval-at ;