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 ( ip netmask -- network ) ;
  10
  11 TUPLE: options
  12 debug?
  13 { ndots integer initial: 1 }
  14 { timeout integer initial: 5 }
  15 { attempts integer initial: 2 }
  16 rotate? no-check-names? inet6? ;
  17
  18 CONSTRUCTOR: options ( -- options ) ;
  19
  20 TUPLE: resolv.conf nameserver domain search sortlist options ;
  21
  22 CONSTRUCTOR: resolv.conf ( -- resolv.conf )
  23     V{ } clone >>nameserver
  24     V{ } clone >>domain
  25     V{ } clone >>search
  26     V{ } clone >>sortlist
  27     <options> >>options ;
  28
  29 <PRIVATE
  30
  31 : trim-blanks ( string -- string' ) [ blank? ] trim ;
  32
  33 : parse-nameserver ( resolv.conf string -- resolv.conf )
  34     trim-blanks " " split
  35     [ trim-blanks ] map harvest over nameserver>> push-all ;
  36
  37 : parse-domain ( resolv.conf string -- resolv.conf )
  38     trim-blanks " " split
  39     [ trim-blanks ] map harvest over domain>> push-all ;
  40
  41 : parse-search ( resolv.conf string -- resolv.conf )
  42     trim-blanks " " split
  43     [ trim-blanks ] map harvest over search>> push-all ;
  44
  45 : parse-sortlist ( resolv.conf string -- resolv.conf )
  46     trim-blanks " " split
  47     [ trim-blanks "/" split1 <network> ] map >>sortlist ;
  48
  49 ERROR: unsupported-resolv.conf-option string ;
  50
  51 : parse-integer ( string -- n )
  52     trim-blanks ":" ?head drop trim-blanks string>number ;
  53
  54 : parse-option ( resolv.conf string -- resolv.conf )
  55     [ dup options>> ] dip trim-blanks {
  56         { [ "debug" ?head ] [ drop t >>debug? ] }
  57         { [ "ndots:" ?head ] [ parse-integer >>ndots ] }
  58         { [ "timeout" ?head ] [ parse-integer >>timeout ] }
  59         { [ "attempts" ?head ] [ parse-integer >>attempts ] }
  60         { [ "rotate" ?head ] [ drop t >>rotate? ] }
  61         { [ "no-check-names" ?head ] [ drop t >>no-check-names? ] }
  62         { [ "inet6" ?head ] [ drop t >>inet6? ] }
  63         [ unsupported-resolv.conf-option ]
  64     } cond drop ;
  65
  66 ERROR: unsupported-resolv.conf-line string ;
  67
  68 : parse-resolv.conf-line ( resolv.conf string -- resolv.conf )
  69     {
  70         { [ "nameserver" ?head ] [ parse-nameserver ] }
  71         { [ "domain" ?head ] [ parse-domain ] }
  72         { [ "search" ?head ] [ parse-search ] }
  73         { [ "sortlist" ?head ] [ parse-sortlist ] }
  74         { [ "options" ?head ] [ parse-option ] }
  75         [ unsupported-resolv.conf-line ]
  76     } cond ;
  77
  78 PRIVATE>
  79
  80 : parse-resolve.conf ( path -- resolv.conf )
  81     [ <resolv.conf> ] dip
  82     utf8 file-lines
  83     [ [ blank? ] trim ] map harvest
  84     [ "#" head? not ] filter
  85     [ parse-resolv.conf-line ] each ;
  86
  87 : default-resolv.conf ( -- resolv.conf )
  88     "/etc/resolv.conf" parse-resolve.conf ;