scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Created structure ips for ip-string related procedures.

This commit is contained in:
mainzelm 2003-02-10 12:30:43 +00:00
parent 0e7152b68b
commit 45223c1d81
3 changed files with 105 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

105
scheme/lib/dns.scm
View File

@ -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,41 +286,11 @@
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)
(filter (lambda (rr)
@ -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)

80
scheme/lib/ip.scm Normal file
View File

@ -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)))

15
scheme/packages.scm
View File

@ -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)