extra/resolv-conf/resolv-conf.factor

   1 ! Copyright (C) 2010 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators constructors io.encodings.utf8
   4 io.files kernel math math.parser sequences splitting
   5 unicode.categories ;
   6 IN: resolv-conf
   7
   8 TUPLE: network ip netmask ;
   9 CONSTRUCTOR: <network> network ( ip netmask -- network ) ;
  10
  11 TUPLE: options
  12 debug?
  13 edns0?
  14 insecure1?
  15 insecure2?
  16 { ndots integer initial: 1 }
  17 { timeout integer initial: 5 }
  18 { attempts integer initial: 2 }
  19 rotate? no-check-names? inet6? tcp? ;
  20
  21 CONSTRUCTOR: <options> options ( -- options ) ;
  22
  23 TUPLE: resolv.conf nameserver domain lookup search sortlist options ;
  24
  25 CONSTRUCTOR: <resolv.conf> resolv.conf ( -- resolv.conf )
  26     V{ } clone >>nameserver
  27     V{ } clone >>domain
  28     V{ } clone >>search
  29     V{ } clone >>sortlist
  30     V{ } clone >>lookup
  31     <options> >>options ;
  32
  33 <PRIVATE
  34
  35 : trim-blanks ( string -- string' ) [ blank? ] trim ;
  36
  37 : split-line ( resolv.conf string -- resolv.conf seq resolv.conf )
  38     trim-blanks " " split
  39     [ trim-blanks ] map harvest over ;
  40
  41 : parse-nameserver ( resolv.conf string -- resolv.conf )
  42     split-line nameserver>> push-all ;
  43
  44 : parse-domain ( resolv.conf string -- resolv.conf )
  45     split-line domain>> push-all ;
  46
  47 : parse-lookup ( resolv.conf string -- resolv.conf )
  48     split-line lookup>> push-all ;
  49
  50 : parse-search ( resolv.conf string -- resolv.conf )
  51     split-line search>> push-all ;
  52
  53 : parse-sortlist ( resolv.conf string -- resolv.conf )
  54     trim-blanks " " split
  55     [ trim-blanks "/" split1 <network> ] map >>sortlist ;
  56
  57 ERROR: unsupported-resolv.conf-option string ;
  58
  59 : parse-integer ( string -- n )
  60     trim-blanks ":" ?head drop trim-blanks string>number ;
  61
  62 : parse-option ( resolv.conf string -- resolv.conf )
  63     [ dup options>> ] dip trim-blanks {
  64         { [ "debug" ?head ] [ drop t >>debug? ] }
  65         { [ "ndots:" ?head ] [ parse-integer >>ndots ] }
  66         { [ "timeout" ?head ] [ parse-integer >>timeout ] }
  67         { [ "attempts" ?head ] [ parse-integer >>attempts ] }
  68         { [ "rotate" ?head ] [ drop t >>rotate? ] }
  69         { [ "no-check-names" ?head ] [ drop t >>no-check-names? ] }
  70         { [ "inet6" ?head ] [ drop t >>inet6? ] }
  71         [ unsupported-resolv.conf-option ]
  72     } cond drop ;
  73
  74 ERROR: unsupported-resolv.conf-line string ;
  75
  76 : parse-resolv.conf-line ( resolv.conf string -- resolv.conf )
  77     {
  78         { [ "nameserver" ?head ] [ parse-nameserver ] }
  79         { [ "domain" ?head ] [ parse-domain ] }
  80         { [ "lookup" ?head ] [ parse-lookup ] }
  81         { [ "search" ?head ] [ parse-search ] }
  82         { [ "sortlist" ?head ] [ parse-sortlist ] }
  83         { [ "options" ?head ] [ parse-option ] }
  84         [ unsupported-resolv.conf-line ]
  85     } cond ;
  86
  87 PRIVATE>
  88
  89 : parse-resolve.conf ( path -- resolv.conf )
  90     [ <resolv.conf> ] dip
  91     utf8 file-lines
  92     [ [ blank? ] trim ] map harvest
  93     [ "#" head? ] reject
  94     [ parse-resolv.conf-line ] each ;
  95
  96 : default-resolv.conf ( -- resolv.conf )
  97     "/etc/resolv.conf" parse-resolve.conf ;