← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/mit-scheme/intrepid-updates

« back to all changes in this revision

Viewing changes to src/runtime/socket.scm

  • Committer: Bazaar Package Importer
  • Author(s): Chris Hanson
  • Date: 2006-09-20 21:59:42 UTC
  • mfrom: (1.1.4 upstream) (3.1.1 etch)
  • Revision ID: james.westby@ubuntu.com-20060920215942-o3erry1wowyk1ezz
No changes; rebuild with downgraded openssl in order to permit
transition into testing.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/runtime/socket.scm
1
1
#| -*-Scheme-*-
2
2
 
3
 
$Id: socket.scm,v 1.26 2005/10/23 21:10:02 cph Exp $
 
3
$Id: socket.scm,v 1.28 2006/06/11 03:04:17 cph Exp $
4
4
 
5
5
Copyright 1996,1997,1998,1999,2001,2002 Massachusetts Institute of Technology
6
 
Copyright 2003,2004,2005 Massachusetts Institute of Technology
 
6
Copyright 2003,2004,2005,2006 Massachusetts Institute of Technology
7
7
 
8
8
This file is part of MIT/GNU Scheme.
9
9
 
29
29
 
30
30
(declare (usual-integrations))
31
31
 
32
 
(define (open-tcp-stream-socket host-name service)
33
 
  (let ((channel (open-tcp-stream-socket-channel host-name service)))
34
 
    (make-generic-i/o-port channel channel)))
35
 
 
36
 
(define (open-unix-stream-socket filename)
37
 
  (let ((channel (open-unix-stream-socket-channel filename)))
38
 
    (make-generic-i/o-port channel channel)))
39
 
 
40
 
(define (open-tcp-stream-socket-channel host-name service)
41
 
  (let ((host (vector-ref (get-host-by-name host-name) 0))
42
 
        (port (tcp-service->port service)))
43
 
    (open-channel
44
 
     (lambda (p)
45
 
       (with-thread-timer-stopped
46
 
         (lambda ()
47
 
           ((ucode-primitive new-open-tcp-stream-socket 3) host port p)))))))
48
 
 
49
 
(define (open-unix-stream-socket-channel filename)
50
 
  (open-channel
51
 
   (lambda (p)
52
 
     (with-thread-timer-stopped
53
 
       (lambda ()
54
 
         ((ucode-primitive new-open-unix-stream-socket 2) filename p))))))
55
 
 
56
32
(define (open-tcp-server-socket service #!optional host)
57
33
  (let ((server-socket (create-tcp-server-socket)))
58
34
    (bind-tcp-server-socket server-socket
120
96
    (and channel
121
97
         (make-generic-i/o-port channel channel))))
122
98
 
 
99
(define (open-tcp-stream-socket host-name service)
 
100
  (let ((channel (open-tcp-stream-socket-channel host-name service)))
 
101
    (make-generic-i/o-port channel channel)))
 
102
 
 
103
(define (open-unix-stream-socket filename)
 
104
  (let ((channel (open-unix-stream-socket-channel filename)))
 
105
    (make-generic-i/o-port channel channel)))
 
106
 
 
107
(define (open-tcp-stream-socket-channel host-name service)
 
108
  (let ((host
 
109
         (vector-ref (or (get-host-by-name host-name)
 
110
                         (error:bad-range-argument
 
111
                          host-name
 
112
                          'open-tcp-stream-socket-channel))
 
113
                     0))
 
114
        (port (tcp-service->port service)))
 
115
    (open-channel
 
116
     (lambda (p)
 
117
       (with-thread-timer-stopped
 
118
         (lambda ()
 
119
           ((ucode-primitive new-open-tcp-stream-socket 3) host port p)))))))
 
120
 
 
121
(define (open-unix-stream-socket-channel filename)
 
122
  (open-channel
 
123
   (lambda (p)
 
124
     (with-thread-timer-stopped
 
125
       (lambda ()
 
126
         ((ucode-primitive new-open-unix-stream-socket 2) filename p))))))
 
127
 
123
128
(define (get-host-by-name host-name)
124
129
  (with-thread-timer-stopped
125
130
    (lambda ()