The unpac monorepo manager self-hosting as a monorepo using unpac
Add checks to the conversion of Unix file descriptors to I/O channels (#1825)
Unix.{in,out}_channel_of_descr now check that descr has stream semantics.
These functions fail if the given file descriptor is not suitable for
character-oriented I/O, e.g. a block device or a datagram socket.
Fixes part of MPR#7238.
authored by
Xavier Leroy
and committed by
GitHub
ea9dc4e5
314cb28e
+224
-5
+6
Changes
+6
Changes
···
135
135
- GPR#1739: ensure ocamltest waits for child processes to terminate on Windows
136
136
(David Allsopp, review by Sébastien Hinderer)
137
137
138
+
- MPR#7238, GPR#1825: in Unix.in_channel_of_descr and Unix.out_channel_of_descr,
139
+
raise an error if the given file description is not suitable for
140
+
character-oriented I/O, for example if it is a block device or a
141
+
datagram socket.
142
+
(Xavier Leroy, review by Jérémie Dimino and Perry E. Metzger)
143
+
138
144
- MPR#7799, GPR#1820: fix bug where Scanf.format_from_string could fail when the
139
145
argument string contained characters that require escaping.
140
146
(Gabriel Scherer and Nicolás Ojeda Bär, report by Guillaume Melquiond, review
+3
-3
otherlibs/unix/Makefile
+3
-3
otherlibs/unix/Makefile
···
22
22
# dllunix.so particularly requires libm for modf symbols
23
23
LDOPTS=$(NATIVECCLIBS)
24
24
25
-
COBJS=accept.o access.o addrofstr.o alarm.o bind.o chdir.o chmod.o \
26
-
chown.o chroot.o close.o closedir.o connect.o cst2constr.o cstringv.o \
27
-
dup.o dup2.o envir.o errmsg.o execv.o execve.o execvp.o exit.o \
25
+
COBJS=accept.o access.o addrofstr.o alarm.o bind.o channels.o chdir.o \
26
+
chmod.o chown.o chroot.o close.o closedir.o connect.o cst2constr.o \
27
+
cstringv.o dup.o dup2.o envir.o errmsg.o execv.o execve.o execvp.o exit.o \
28
28
fchmod.o fchown.o fcntl.o fork.o ftruncate.o \
29
29
getaddrinfo.o getcwd.o getegid.o geteuid.o getgid.o \
30
30
getgr.o getgroups.o gethost.o gethostname.o getlogin.o \
+90
otherlibs/unix/channels.c
+90
otherlibs/unix/channels.c
···
1
+
/**************************************************************************/
2
+
/* */
3
+
/* OCaml */
4
+
/* */
5
+
/* Xavier Leroy, projet Gallium, INRIA Paris */
6
+
/* */
7
+
/* Copyright 2017 Institut National de Recherche en Informatique et */
8
+
/* en Automatique. */
9
+
/* */
10
+
/* All rights reserved. This file is distributed under the terms of */
11
+
/* the GNU Lesser General Public License version 2.1, with the */
12
+
/* special exception on linking described in the file LICENSE. */
13
+
/* */
14
+
/**************************************************************************/
15
+
16
+
#define CAML_INTERNALS
17
+
18
+
#include <errno.h>
19
+
#include <sys/types.h>
20
+
#include <sys/stat.h>
21
+
#include <caml/mlvalues.h>
22
+
#include <caml/io.h>
23
+
#include <caml/signals.h>
24
+
#include "unixsupport.h"
25
+
26
+
#ifdef HAS_SOCKETS
27
+
#include <sys/socket.h>
28
+
#include "socketaddr.h"
29
+
#endif
30
+
31
+
/* Check that the given file descriptor has "stream semantics" and
32
+
can therefore be used as part of buffered I/O. Things that
33
+
don't have "stream semantics" include block devices and
34
+
UDP (datagram) sockets.
35
+
Returns 0 if OK, a nonzero error code if error. */
36
+
37
+
static int unix_check_stream_semantics(int fd)
38
+
{
39
+
struct stat buf;
40
+
41
+
if (fstat(fd, &buf) == -1) return errno;
42
+
switch (buf.st_mode & S_IFMT) {
43
+
case S_IFREG: case S_IFCHR: case S_IFIFO:
44
+
/* These have stream semantics */
45
+
return 0;
46
+
#ifdef HAS_SOCKETS
47
+
case S_IFSOCK: {
48
+
int so_type;
49
+
socklen_param_type so_type_len = sizeof(so_type);
50
+
if (getsockopt(fd, SOL_SOCKET, SO_TYPE, &so_type, &so_type_len) == -1)
51
+
return errno;
52
+
switch (so_type) {
53
+
case SOCK_STREAM:
54
+
return 0;
55
+
default:
56
+
return EINVAL;
57
+
}
58
+
}
59
+
#endif
60
+
default:
61
+
/* All other file types are suspect: block devices, directories,
62
+
symbolic links, whatnot. */
63
+
return EINVAL;
64
+
}
65
+
}
66
+
67
+
/* From byterun/io.c. To be declared in <caml/io.h> ? */
68
+
extern value caml_ml_open_descriptor_in(value fd);
69
+
extern value caml_ml_open_descriptor_out(value fd);
70
+
71
+
CAMLprim value unix_inchannel_of_filedescr(value fd)
72
+
{
73
+
int err;
74
+
caml_enter_blocking_section();
75
+
err = unix_check_stream_semantics(Int_val(fd));
76
+
caml_leave_blocking_section();
77
+
if (err != 0) unix_error(err, "in_channel_of_descr", Nothing);
78
+
return caml_ml_open_descriptor_in(fd);
79
+
}
80
+
81
+
CAMLprim value unix_outchannel_of_filedescr(value fd)
82
+
{
83
+
int err;
84
+
caml_enter_blocking_section();
85
+
err = unix_check_stream_semantics(Int_val(fd));
86
+
caml_leave_blocking_section();
87
+
if (err != 0) unix_error(err, "out_channel_of_descr", Nothing);
88
+
return caml_ml_open_descriptor_out(fd);
89
+
}
90
+
+2
-2
otherlibs/unix/unix.ml
+2
-2
otherlibs/unix/unix.ml
···
334
334
single_write fd (Bytes.unsafe_of_string buf) ofs len
335
335
336
336
external in_channel_of_descr : file_descr -> in_channel
337
-
= "caml_ml_open_descriptor_in"
337
+
= "unix_inchannel_of_filedescr"
338
338
external out_channel_of_descr : file_descr -> out_channel
339
-
= "caml_ml_open_descriptor_out"
339
+
= "unix_outchannel_of_filedescr"
340
340
external descr_of_in_channel : in_channel -> file_descr
341
341
= "caml_channel_descriptor"
342
342
external descr_of_out_channel : out_channel -> file_descr
+42
otherlibs/win32unix/channels.c
+42
otherlibs/win32unix/channels.c
···
23
23
#include <fcntl.h>
24
24
#include <io.h>
25
25
26
+
/* Check that the given file descriptor has "stream semantics" and
27
+
can therefore be used as part of buffered I/O. Things that
28
+
don't have "stream semantics" include block devices and
29
+
UDP (datagram) sockets.
30
+
Returns 0 if OK, a Win32 error code if error. */
31
+
32
+
static DWORD win_check_stream_semantics(value handle)
33
+
{
34
+
switch (Descr_kind_val(handle)) {
35
+
case KIND_HANDLE:
36
+
switch (GetFileType(Handle_val(handle)) & ~FILE_TYPE_REMOTE) {
37
+
case FILE_TYPE_DISK: case FILE_TYPE_CHAR: case FILE_TYPE_PIPE:
38
+
return 0;
39
+
default: {
40
+
DWORD err = GetLastError();
41
+
return err == NO_ERROR ? ERROR_INVALID_ACCESS : err;
42
+
}
43
+
}
44
+
case KIND_SOCKET: {
45
+
int so_type;
46
+
int so_type_len = sizeof(so_type);
47
+
if (getsockopt(Socket_val(handle), SOL_SOCKET, SO_TYPE,
48
+
(void *) &so_type, &so_type_len) != 0)
49
+
return WSAGetLastError();
50
+
switch (so_type) {
51
+
case SOCK_STREAM:
52
+
return 0;
53
+
default:
54
+
return ERROR_INVALID_ACCESS;
55
+
}
56
+
}
57
+
default:
58
+
return ERROR_INVALID_ACCESS;
59
+
}
60
+
}
61
+
26
62
int win_CRT_fd_of_filedescr(value handle)
27
63
{
28
64
if (CRT_fd_val(handle) != NO_CRT_FD) {
···
40
76
CAMLparam1(handle);
41
77
CAMLlocal1(vchan);
42
78
struct channel * chan;
79
+
DWORD err;
43
80
44
81
#if defined(_MSC_VER) && _MSC_VER < 1400
45
82
fflush(stdin);
46
83
#endif
84
+
err = win_check_stream_semantics(handle);
85
+
if (err != 0) { win32_maperr(err); uerror("in_channel_of_descr", Nothing); }
47
86
chan = caml_open_descriptor_in(win_CRT_fd_of_filedescr(handle));
48
87
chan->flags |= CHANNEL_FLAG_MANAGED_BY_GC;
49
88
/* as in caml_ml_open_descriptor_in() */
···
59
98
CAMLlocal1(vchan);
60
99
int fd;
61
100
struct channel * chan;
101
+
DWORD err;
62
102
103
+
err = win_check_stream_semantics(handle);
104
+
if (err != 0) { win32_maperr(err); uerror("out_channel_of_descr", Nothing); }
63
105
chan = caml_open_descriptor_out(win_CRT_fd_of_filedescr(handle));
64
106
chan->flags |= CHANNEL_FLAG_MANAGED_BY_GC;
65
107
/* as in caml_ml_open_descriptor_out() */
+68
testsuite/tests/lib-unix/common/channel_of.ml
+68
testsuite/tests/lib-unix/common/channel_of.ml
···
1
+
(* TEST
2
+
include unix
3
+
*)
4
+
5
+
open Printf
6
+
7
+
let shouldpass msg fn arg =
8
+
try
9
+
ignore (fn arg); printf "%s: passed (no error)\n" msg
10
+
with Unix.Unix_error(err, _, _) ->
11
+
printf "%s: FAILED (error %s)\n" msg (Unix.error_message err)
12
+
13
+
let shouldfail msg fn arg =
14
+
try
15
+
ignore (fn arg); printf "%s: FAILED (no error raised)\n" msg
16
+
with Unix.Unix_error(err, _, _) ->
17
+
printf "%s: passed (error raised)\n" msg
18
+
19
+
let _ =
20
+
(* Files *)
21
+
begin
22
+
let fd = Unix.(openfile "file.tmp" [O_WRONLY;O_CREAT;O_TRUNC] 0o666) in
23
+
shouldpass "File 1" Unix.in_channel_of_descr fd;
24
+
shouldpass "File 2" Unix.out_channel_of_descr fd;
25
+
Unix.close fd
26
+
end;
27
+
(* Pipes *)
28
+
begin
29
+
let out, inp = Unix.pipe () in
30
+
shouldpass "Pipe 1" Unix.in_channel_of_descr out;
31
+
shouldpass "Pipe 2" Unix.out_channel_of_descr inp;
32
+
Unix.close out; Unix.close inp
33
+
end;
34
+
(* Sockets *)
35
+
let addr = Unix.ADDR_INET(Unix.inet_addr_loopback, 0) in
36
+
begin
37
+
let sock =
38
+
Unix.socket (Unix.domain_of_sockaddr addr) Unix.SOCK_STREAM 0 in
39
+
shouldpass "Stream socket 1" Unix.in_channel_of_descr sock;
40
+
shouldpass "Stream socket 2" Unix.out_channel_of_descr sock;
41
+
Unix.close sock
42
+
end;
43
+
begin
44
+
let sock =
45
+
Unix.socket (Unix.domain_of_sockaddr addr) Unix.SOCK_DGRAM 0 in
46
+
shouldfail "Stream socket 1" Unix.in_channel_of_descr sock;
47
+
shouldfail "Stream socket 2" Unix.out_channel_of_descr sock;
48
+
Unix.close sock
49
+
end;
50
+
(* Whatever is connected to standard descriptors; hopefully a terminal *)
51
+
begin
52
+
shouldpass "stdin" Unix.in_channel_of_descr Unix.stdin;
53
+
shouldpass "stderr" Unix.out_channel_of_descr Unix.stderr
54
+
end;
55
+
(* A closed file descriptor should now fail *)
56
+
begin
57
+
let fd = Unix.(openfile "file.tmp" [O_WRONLY;O_CREAT;O_TRUNC] 0o666) in
58
+
Unix.close fd;
59
+
shouldfail "Closed file 1" Unix.in_channel_of_descr fd;
60
+
shouldfail "Closed file 2" Unix.out_channel_of_descr fd
61
+
end;
62
+
(* End of test *)
63
+
Sys.remove "file.tmp"
64
+
65
+
66
+
67
+
68
+
+12
testsuite/tests/lib-unix/common/channel_of.reference
+12
testsuite/tests/lib-unix/common/channel_of.reference
···
1
+
File 1: passed (no error)
2
+
File 2: passed (no error)
3
+
Pipe 1: passed (no error)
4
+
Pipe 2: passed (no error)
5
+
Stream socket 1: passed (no error)
6
+
Stream socket 2: passed (no error)
7
+
Stream socket 1: passed (error raised)
8
+
Stream socket 2: passed (error raised)
9
+
stdin: passed (no error)
10
+
stderr: passed (no error)
11
+
Closed file 1: passed (error raised)
12
+
Closed file 2: passed (error raised)