Updated csug socket code to match that in examples folder

original commit: 5bdf715809e5847dfa0807216bcc6d0dac2f10ea
This commit is contained in:
Bob Burger 2018-06-18 09:28:53 -04:00
parent 2f355b464e
commit 3c7c397fff
3 changed files with 51 additions and 43 deletions

2
LOG
View File

@ -958,3 +958,5 @@
x86_64.ss, foreign.ms, foreign4.c
- Avoid an occasional invalid memory violation on Windows in S_call_help
schlib.c
- Updated csug socket code to match that in examples folder
csug/foreign.stex, examples/socket.ss

View File

@ -3585,12 +3585,14 @@ transparent input from and output to a subprocess via a Scheme port.
#include <signal.h>
#include <sys/ioctl.h>
#include <stdio.h>
#include <unistd.h>
/* c_write attempts to write the entire buffer, pushing through
interrupts, socket delays, and partial-buffer writes */
int c_write(int fd, char *buf, unsigned n) {
unsigned i, m;
int c_write(int fd, char *buf, ssize_t start, ssize_t n) {
ssize_t i, m;
buf += start;
m = n;
while (m > 0) {
if ((i = write(fd, buf, m)) < 0) {
@ -3605,9 +3607,10 @@ int c_write(int fd, char *buf, unsigned n) {
}
/* c_read pushes through interrupts and socket delays */
int c_read(int fd, char *buf, unsigned n) {
int c_read(int fd, char *buf, size_t start, size_t n) {
int i;
buf += start;
for (;;) {
i = read(fd, buf, n);
if (i >= 0) return i;
@ -3641,17 +3644,17 @@ int do_bind(int s, char *name) {
(void) strcpy(sun.sun_path, name);
length = sizeof(sun.sun_family) + sizeof(sun.sun_path);
return bind(s, &sun, length);
return bind(s, (struct sockaddr*)(&sun), length);
}
/* do_accept accepts a connection on socket s */
int do_accept(int s) {
struct sockaddr_un sun;
int length;
socklen_t length;
length = sizeof(sun.sun_family) + sizeof(sun.sun_path);
return accept(s, &sun, &length);
return accept(s, (struct sockaddr*)(&sun), &length);
}
/* do_connect initiates a socket connection */
@ -3663,7 +3666,7 @@ int do_connect(int s, char *name) {
(void) strcpy(sun.sun_path, name);
length = sizeof(sun.sun_family) + sizeof(sun.sun_path);
return connect(s, &sun, length);
return connect(s, (struct sockaddr*)(&sun), length);
}
/* get_error returns the operating system's error status */
@ -3679,86 +3682,89 @@ char* get_error(void) {
;;; socket.ss
;;; Requires csocket.so, built from csocket.c.
(case (machine-type)
[(i3le ti3le) (load-shared-object "libc.so.6")]
[(i3osx ti3osx) (load-shared-object "libc.dylib")]
[else (load-shared-object "libc.so")])
;;; Example compilation command line from macOS:
;;; cc -c csocket.c -o csocket.o
;;; cc csocket.o -dynamic -dynamiclib -current_version 1.0 -compatibility_version 1.0 -o csocket.so
(load-shared-object "./csocket.so")
;;; Requires from C library:
;;; close, dup, execl, fork, kill, listen, tmpnam, unlink
(load-shared-object "libc.so")
(case (machine-type)
[(i3le ti3le a6le ta6le) (load-shared-object "libc.so.6")]
[(i3osx ti3osx a6osx ta6osx) (load-shared-object "libc.dylib")]
[else (load-shared-object "libc.so")])
;;; basic C-library stuff
(define close
(foreign-procedure "close" (integer-32)
integer-32))
(foreign-procedure "close" (int)
int))
(define dup
(foreign-procedure "dup" (integer-32)
integer-32))
(foreign-procedure "dup" (int)
int))
(define execl4
(let ([execl-help
(let ((execl-help
(foreign-procedure "execl"
(string string string string integer-32)
integer-32)])
(string string string string void*)
int)))
(lambda (s1 s2 s3 s4)
(execl-help s1 s2 s3 s4 0))))
(define fork
(foreign-procedure "fork" ()
integer-32))
int))
(define kill
(foreign-procedure "kill" (integer-32 integer-32)
integer-32))
(foreign-procedure "kill" (int int)
int))
(define listen
(foreign-procedure "listen" (integer-32 integer-32)
integer-32))
(foreign-procedure "listen" (int int)
int))
(define tmpnam
(foreign-procedure "tmpnam" (integer-32)
(foreign-procedure "tmpnam" (void*)
string))
(define unlink
(foreign-procedure "unlink" (string)
integer-32))
int))
;;; routines defined in csocket.c
(define accept
(foreign-procedure "do_accept" (integer-32)
integer-32))
(foreign-procedure "do_accept" (int)
int))
(define bytes-ready?
(foreign-procedure "bytes_ready" (integer-32)
(foreign-procedure "bytes_ready" (int)
boolean))
(define bind
(foreign-procedure "do_bind" (integer-32 string)
integer-32))
(foreign-procedure "do_bind" (int string)
int))
(define c-error
(foreign-procedure "get_error" ()
string))
(define c-read
(foreign-procedure "c_read" (integer-32 string integer-32)
integer-32))
(foreign-procedure "c_read" (int u8* size_t size_t)
ssize_t))
(define c-write
(foreign-procedure "c_write" (integer-32 string integer-32)
integer-32))
(foreign-procedure "c_write" (int u8* size_t ssize_t)
ssize_t))
(define connect
(foreign-procedure "do_connect" (integer-32 string)
integer-32))
(foreign-procedure "do_connect" (int string)
int))
(define socket
(foreign-procedure "do_socket" ()
integer-32))
int))
;;; higher-level routines
@ -3768,7 +3774,7 @@ char* get_error(void) {
(lambda (old new)
(check 'close (close old))
(unless (= (dup new) old)
(errorf 'dodup
(error 'dodup
"couldn't set up child process io for fd ~s" old))))
(define dofork
@ -3779,7 +3785,7 @@ char* get_error(void) {
(cond
[(= pid 0) (child)]
[(> pid 0) (parent pid)]
[else (errorf 'fork (c-error))]))))
[else (error 'fork (c-error))]))))
(define setup-server-socket
; create a socket, bind it to name, and listen for connections
@ -3803,11 +3809,11 @@ char* get_error(void) {
(check 'accept (accept sock))))
(define check
; raise an exception if status x is negative, using c-error to
; signal an error if status x is negative, using c-error to
; obtain the operating-system's error message
(lambda (who x)
(if (< x 0)
(errorf who (c-error))
(error who (c-error))
x)))
(define terminate-process

View File

@ -16,7 +16,7 @@
;;; Requires from C library:
;;; close, dup, execl, fork, kill, listen, tmpnam, unlink
(case (machine-type)
[(i3le ti3le) (load-shared-object "libc.so.6")]
[(i3le ti3le a6le ta6le) (load-shared-object "libc.so.6")]
[(i3osx ti3osx a6osx ta6osx) (load-shared-object "libc.dylib")]
[else (load-shared-object "libc.so")])