diff --git a/scheme/lib/dns.scm b/scheme/lib/dns.scm index 41dc2ea..9225b71 100644 --- a/scheme/lib/dns.scm +++ b/scheme/lib/dns.scm @@ -274,61 +274,8 @@ (define (add-size-tag m) (append (number->octet-pair (length m)) m)) -;; converts an octeted-ip to a 32bit integer internet-address -(define (octet-ip->address32 ip) - (+ (arithmetic-shift (char->ascii (list-ref ip 0)) 24) - (arithmetic-shift (char->ascii (list-ref ip 1)) 16) - (arithmetic-shift (char->ascii (list-ref ip 2)) 8) - (char->ascii (list-ref ip 3)))) -;; converts a 32 bit integer internet-address to an octeted-ip -(define (address32->octet-ip ip) - (list (arithmetic-shift ip -24) - (modulo (arithmetic-shift ip -16) 256) - (modulo (arithmetic-shift ip -8) 256) - (modulo ip 256))) -;; converts an ip-string to an 32bit integer internet-address -(define (ip-string->address32 ip) - (octet-ip->address32 (ip-string->octet-ip ip))) - -;; converts an ip-string to an 32bit integer internet-address -(define (address32->ip-string ip) - (format #f - "~a.~a.~a.~a" - (arithmetic-shift ip -24) - (modulo (arithmetic-shift ip -16) 256) - (modulo (arithmetic-shift ip -8) 256) - (modulo ip 256))) - -;; converts an octeted-ip to an human readable ip-string -(define (octet-ip->ip-string s) - (format #f - "~a.~a.~a.~a" - (char->ascii (list-ref s 0)) - (char->ascii (list-ref s 1)) - (char->ascii (list-ref s 2)) - (char->ascii (list-ref s 3)))) - -(define ip-string-regexp (rx (: bos - (submatch (** 1 3 digit)) "." - (submatch (** 1 3 digit)) "." - (submatch (** 1 3 digit)) "." - (submatch (** 1 3 digit)) - eos))) - -;; converts an ip-string to octets -(define (ip-string->octet-ip s) - (cond - ((regexp-search ip-string-regexp s) - => (lambda (match) - (list - (ascii->char (string->number (match:substring match 1))) - (ascii->char (string->number (match:substring match 2))) - (ascii->char (string->number (match:substring match 3))) - (ascii->char (string->number (match:substring match 4)))))) - (else - (error "invalid ip-string" s)))) ;; calculates a "random" number, needed for message-ids ;; TODO use SRFI-27 @@ -339,40 +286,10 @@ limit) 314159265)))) -;; checks if a string is a ip -(define (ip-string? s) - (define (byte-as-string? string) - (let ((number (string->number string))) - (and number - (>= number 0) - (< number 256)))) - (cond - ((regexp-search ip-string-regexp s) - => (lambda (match) - (and (byte-as-string? (match:substring match 1)) - (byte-as-string? (match:substring match 2)) - (byte-as-string? (match:substring match 3)) - (byte-as-string? (match:substring match 4))))) - (else #f))) - - ;; checks if v is a address32 (define (address32? v) (and (number? v) (<= 0 v #xffffffff))) - -;; returns a in-addr.arpa name-string or #f (needed to resolve hostname by ip) -(define (ip-string->in-addr-arpa s) - (cond - ((regexp-search ip-string-regexp s) - => (lambda (match) - (string-append - (match:substring match 4) "." - (match:substring match 3) "." - (match:substring match 2) "." - (match:substring match 1) "." - "in-addr.arpa"))) - (else #f))) ;; filters types in a list of rrs (define (filter-type list type) @@ -1275,8 +1192,8 @@ (define (dns-lookup name type . args) (receive (nameservers use-cache?) (lookup-optional-args args) (let* ((maybe-ip-string (if (address32? name) - (ip-string->in-addr-arpa (address32->ip-string name)) - (ip-string->in-addr-arpa name))) + (ip-string->in-addr.arpa-string (address32->ip-string name)) + (ip-string->in-addr.arpa-string name))) (query (if maybe-ip-string ; if name is a ip-addr, the query is a in-addr.arpa address (make-simple-query-message maybe-ip-string type (message-class in)) @@ -1293,8 +1210,8 @@ (define (dns-lookup-name name . args) (receive (nameservers use-cache?) (lookup-optional-args args) (let* ((maybe-ip-string (if (address32? name) - (ip-string->in-addr-arpa (address32->ip-string name)) - (ip-string->in-addr-arpa name))) + (ip-string->in-addr.arpa-string (address32->ip-string name)) + (ip-string->in-addr.arpa-string name))) (query (if maybe-ip-string ; if name is a ip-addr, the query is a in-addr.arpa address (dns-error 'not-a-hostname) (make-simple-query-message name (message-type a) (message-class in)))) @@ -1312,8 +1229,8 @@ (define (dns-lookup-ip ip . args) (receive (nameservers use-cache?) (lookup-optional-args args) (let* ((maybe-ip-string (if (address32? ip) - (ip-string->in-addr-arpa (address32->ip-string ip)) - (ip-string->in-addr-arpa ip))) + (ip-string->in-addr.arpa-string (address32->ip-string ip)) + (ip-string->in-addr.arpa-string ip))) (query (if maybe-ip-string ; if name is a ip-addr, the query is a in-addr.arpa address (make-simple-query-message maybe-ip-string (message-type ptr) (message-class in)) (dns-error 'not-a-ip))) @@ -1334,8 +1251,8 @@ (define (dns-lookup-nameserver name . args) (receive (nameservers use-cache?) (lookup-optional-args args) (let* ((maybe-ip-string (if (address32? name) - (ip-string->in-addr-arpa (address32->ip-string name)) - (ip-string->in-addr-arpa name))) + (ip-string->in-addr.arpa-string (address32->ip-string name)) + (ip-string->in-addr.arpa-string name))) (query (if maybe-ip-string ; if name is a ip-addr, the query is a in-addr.arpa address (dns-error 'not-a-hostname) (make-simple-query-message @@ -1364,8 +1281,8 @@ (define (dns-lookup-mail-exchanger name . args) (receive (nameservers use-cache?) (lookup-optional-args args) (let* ((ip-string (if (address32? name) - (ip-string->in-addr-arpa (address32->ip-string name)) - (ip-string->in-addr-arpa name))) + (ip-string->in-addr.arpa-string (address32->ip-string name)) + (ip-string->in-addr.arpa-string name))) (query (if ip-string ; if name is a ip-addr, the query is a in-addr.arpa address (dns-error 'not-a-hostname) (make-simple-query-message @@ -1543,7 +1460,7 @@ (if (socket-address? name-or-socket-address) (apply socket-address->fqdn name-or-socket-address args) (let ((name name-or-socket-address)) - (if (is-fqdn? name) + (if (fqdn? name) name (let lp ((domains (domains-for-search))) (if (null? domains) diff --git a/scheme/lib/ip.scm b/scheme/lib/ip.scm new file mode 100644 index 0000000..2f81805 --- /dev/null +++ b/scheme/lib/ip.scm @@ -0,0 +1,80 @@ +;; converts an ip-string to an 32bit integer internet-address +(define (address32->ip-string ip) + (octet-ip->ip-string (address32->octet-ip ip))) + +;; converts an ip-string to an 32bit integer internet-address +(define (ip-string->address32 ip) + (octet-ip->address32 (ip-string->octet-ip ip))) + +;; checks if a string is a ip +(define (ip-string? s) + (define (byte-as-string? string) + (let ((number (string->number string))) + (and number + (>= number 0) + (< number 256)))) + (cond + ((regexp-search ip-string-regexp s) + => (lambda (match) + (and (byte-as-string? (match:substring match 1)) + (byte-as-string? (match:substring match 2)) + (byte-as-string? (match:substring match 3)) + (byte-as-string? (match:substring match 4))))) + (else #f))) + +;; converts an ip-string to octets +(define (ip-string->octet-ip s) + (cond + ((regexp-search ip-string-regexp s) + => (lambda (match) + (list + (ascii->char (string->number (match:substring match 1))) + (ascii->char (string->number (match:substring match 2))) + (ascii->char (string->number (match:substring match 3))) + (ascii->char (string->number (match:substring match 4)))))) + (else + (error "invalid ip-string" s)))) + +;; converts an octeted-ip to a 32bit integer internet-address +(define (octet-ip->address32 ip) + (+ (arithmetic-shift (char->ascii (list-ref ip 0)) 24) + (arithmetic-shift (char->ascii (list-ref ip 1)) 16) + (arithmetic-shift (char->ascii (list-ref ip 2)) 8) + (char->ascii (list-ref ip 3)))) + +;; converts a 32 bit integer internet-address to an octeted-ip +(define (address32->octet-ip ip) + (list (ascii->char (arithmetic-shift ip -24)) + (ascii->char (modulo (arithmetic-shift ip -16) 256)) + (ascii->char (modulo (arithmetic-shift ip -8) 256)) + (ascii->char (modulo ip 256)))) + + +;; converts an octeted-ip to an human readable ip-string +(define (octet-ip->ip-string s) + (format #f + "~a.~a.~a.~a" + (char->ascii (list-ref s 0)) + (char->ascii (list-ref s 1)) + (char->ascii (list-ref s 2)) + (char->ascii (list-ref s 3)))) + +;; returns a in-addr.arpa name-string or #f (needed to resolve hostname by ip) +(define (ip-string->in-addr.arpa-string s) + (cond + ((regexp-search ip-string-regexp s) + => (lambda (match) + (string-append + (match:substring match 4) "." + (match:substring match 3) "." + (match:substring match 2) "." + (match:substring match 1) "." + "in-addr.arpa"))) + (else #f))) + +(define ip-string-regexp (rx (: bos + (submatch (** 1 3 digit)) "." + (submatch (** 1 3 digit)) "." + (submatch (** 1 3 digit)) "." + (submatch (** 1 3 digit)) + eos))) diff --git a/scheme/packages.scm b/scheme/packages.scm index 4c7581e..38db66b 100644 --- a/scheme/packages.scm +++ b/scheme/packages.scm @@ -159,6 +159,13 @@ host-fqdn system-fqdn)) +(define-interface ips-interface + (export address32->ip-string + ip-string->address32 + ip-string->in-addr.arpa-string + octet-ip->address32 ;for dns.scm + ip-string?)) + (define-interface cgi-scripts-interface (export cgi-form-query)) @@ -479,9 +486,15 @@ handle sort threads - locks) + locks + ips) (files (lib dns))) +(define-structure ips ips-interface + (open scheme-with-scsh + formats) + (files (lib ip))) + (define-structure cgi-scripts cgi-scripts-interface (open scheme-with-scsh parse-html-forms)