Add racket/os library.

For now this just contains two functions from mzlib/os.
This commit is contained in:
Asumu Takikawa 2015-05-29 16:57:31 -04:00 committed by Matthew Flatt
parent 09a2b630bc
commit a729c028a6
3 changed files with 87 additions and 0 deletions

View File

@ -0,0 +1,18 @@
#lang scribble/doc
@(require "mz.rkt"
(for-label racket/os))
@title[#:tag "os-lib"]{Additional Operating System Functions}
@defmodule[racket/os]{The @racketmodname[racket/os] library
additional functions for querying the operating system.}
@history[#:added "6.2.900.17"]
@defproc[(gethostname) string?]{
Returns a string for the current machine's hostname (including its domain).
}
@defproc[(getpid) exact-integer?]{
Returns an integer identifying the current process within the operating system.
}

View File

@ -14,3 +14,4 @@
@include-section["envvars.scrbl"]
@include-section["runtime.scrbl"]
@include-section["cmdline.scrbl"]
@include-section["os-lib.scrbl"]

View File

@ -0,0 +1,68 @@
#lang racket/base
;; Provides additional functions for querying OS information
(require (prefix-in c: racket/contract)
racket/promise
ffi/unsafe
ffi/cvector
ffi/winapi)
(provide (c:contract-out [getpid (c:-> exact-integer?)]
[gethostname (c:-> string?)]))
(define kernel32
(delay (and (eq? 'windows (system-type)) (ffi-lib "kernel32"))))
(define (delay-ffi-obj name lib type)
(delay (get-ffi-obj name lib type)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gethostname
(define BUFFER-SIZE 1024)
(define (extract-terminated-string proc)
(let ([s (make-bytes BUFFER-SIZE)])
(if (proc s BUFFER-SIZE)
(bytes->string/utf-8 (car (regexp-match #rx#"^[^\0]*" s)))
(error 'gethostname "could not get hostname"))))
(define unix-gethostname
(delay-ffi-obj "gethostname" #f (_fun _bytes _int -> _int)))
(define windows-getcomputername
(delay-ffi-obj "GetComputerNameExA" (force kernel32)
(_fun #:abi winapi _int _bytes _cvector -> _int)))
(define (gethostname)
(case (system-type)
[(unix macosx)
(let ([ghn (force unix-gethostname)])
(extract-terminated-string (lambda (s sz) (zero? (ghn s sz)))))]
[(windows)
(let ([gcn (force windows-getcomputername)]
[DNS_FULLY_QUALIFIED 3])
(extract-terminated-string
(lambda (s sz)
(let ([sz_ptr (cvector _int sz)])
(and (not (zero? (gcn DNS_FULLY_QUALIFIED s sz_ptr)))
(let ([sz (cvector-ref sz_ptr 0)])
(when (sz . < . (bytes-length s)) (bytes-set! s sz 0))
#t))))))]
[else #f]))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; getpid
(define unix-getpid
(delay-ffi-obj "getpid" #f (_fun -> _int)))
(define windows-getpid
(delay-ffi-obj "GetCurrentProcessId" (force kernel32)
(_fun #:abi winapi -> _int)))
(define (getpid)
((force (case (system-type)
[(macosx unix) unix-getpid]
[(windows) windows-getpid]
[else (error 'getpid "unknown platform ~e" (system-type))]))))