From 47e04b88578bf661b9a5d35a53c7a44f4e99b9f7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= <antonin@tarides.com>
Date: Mon, 18 Oct 2021 15:17:46 +0200
Subject: [PATCH] Treat ERROR_BROKEN_PIPE on read as zero-read instead of error

This matches the behaviour of win32unix since 3.11.1, see OCaml PR
4790.
---
 CHANGES                                     | 3 +++
 src/unix/windows_c/windows_bytes_read.c     | 7 ++++++-
 src/unix/windows_c/windows_bytes_read_job.c | 7 ++++++-
 src/unix/windows_c/windows_pread.c          | 7 ++++++-
 src/unix/windows_c/windows_pread_job.c      | 7 ++++++-
 src/unix/windows_c/windows_read.c           | 7 ++++++-
 src/unix/windows_c/windows_read_job.c       | 7 ++++++-
 7 files changed, 39 insertions(+), 6 deletions(-)

diff --git a/CHANGES b/CHANGES
index 624cc0318c..b207cdb787 100644
--- a/CHANGES
+++ b/CHANGES
@@ -12,6 +12,9 @@
     the behavior of Lwt_io.with_temp_dir following symlinks to
     directories on Win32. (#883, Antonin Décimo)
 
+  * On Windows, treat ERROR_BROKEN_PIPE on read as zero-read instead
+    of error. See OCaml PR #4790. (#898, Antonin Décimo)
+
 ====== Additions ======
 
   * Lwt_bytes.blit_from_string: string complement of Lwt_bytes.blit (#882, Hugo Heuzard).
diff --git a/src/unix/windows_c/windows_bytes_read.c b/src/unix/windows_c/windows_bytes_read.c
index 1fddb8e927..d200f2b8e9 100644
--- a/src/unix/windows_c/windows_bytes_read.c
+++ b/src/unix/windows_c/windows_bytes_read.c
@@ -37,7 +37,12 @@ CAMLprim value lwt_unix_bytes_read(value fd, value buf, value vofs, value vlen)
                           numbytes, &numwritten, NULL))
                 err = GetLastError();
         }
-        if (err) {
+        if (err == ERROR_BROKEN_PIPE) {
+            /* The write handle for an anonymous pipe has been closed. We match
+               the Unix behavior, and treat this as a zero-read instead of a
+               Unix_error. See OCaml PR #4790. */
+            numwritten = 0;
+        } else if (err) {
             win32_maperr(err);
             uerror("write", Nothing);
         }
diff --git a/src/unix/windows_c/windows_bytes_read_job.c b/src/unix/windows_c/windows_bytes_read_job.c
index 32aeca0d5e..b050b36683 100644
--- a/src/unix/windows_c/windows_bytes_read_job.c
+++ b/src/unix/windows_c/windows_bytes_read_job.c
@@ -47,7 +47,12 @@ static value result_bytes_read(struct job_bytes_read *job)
     value result;
     DWORD error = job->error_code;
     caml_remove_generational_global_root(&job->ocaml_buffer);
-    if (error) {
+    if (error == ERROR_BROKEN_PIPE) {
+        /* The write handle for an anonymous pipe has been closed. We match the
+           Unix behavior, and treat this as a zero-read instead of a Unix_error.
+           See OCaml PR #4790. */
+        job->result = 0;
+    } else if (error) {
         lwt_unix_free_job(&job->job);
         win32_maperr(error);
         uerror("bytes_read", Nothing);
diff --git a/src/unix/windows_c/windows_pread.c b/src/unix/windows_c/windows_pread.c
index 9511fe6069..d1d5607635 100644
--- a/src/unix/windows_c/windows_pread.c
+++ b/src/unix/windows_c/windows_pread.c
@@ -38,7 +38,12 @@ CAMLprim value lwt_unix_pread(value fd, value buf, value vfile_offset,
                           &overlapped))
                 err = GetLastError();
         }
-        if (err) {
+        if (err == ERROR_BROKEN_PIPE) {
+            /* The write handle for an anonymous pipe has been closed. We match
+               the Unix behavior, and treat this as a zero-read instead of a
+               Unix_error. See OCaml PR #4790. */
+            numwritten = 0;
+        } else if (err) {
             win32_maperr(err);
             uerror("pread", Nothing);
         }
diff --git a/src/unix/windows_c/windows_pread_job.c b/src/unix/windows_c/windows_pread_job.c
index cb729c78c0..1dff0b6b2f 100644
--- a/src/unix/windows_c/windows_pread_job.c
+++ b/src/unix/windows_c/windows_pread_job.c
@@ -47,7 +47,12 @@ static value result_pread(struct job_pread *job)
 {
     value result;
     DWORD error = job->error_code;
-    if (error) {
+    if (error == ERROR_BROKEN_PIPE) {
+        /* The write handle for an anonymous pipe has been closed. We match the
+           Unix behavior, and treat this as a zero-read instead of a Unix_error.
+           See OCaml PR #4790. */
+        job->result = 0;
+    } else if (error) {
         caml_remove_generational_global_root(&job->string);
         lwt_unix_free_job(&job->job);
         win32_maperr(error);
diff --git a/src/unix/windows_c/windows_read.c b/src/unix/windows_c/windows_read.c
index 1beeafa746..caa773150f 100644
--- a/src/unix/windows_c/windows_read.c
+++ b/src/unix/windows_c/windows_read.c
@@ -34,7 +34,12 @@ CAMLprim value lwt_unix_read(value fd, value buf, value vofs, value vlen)
             if (!ReadFile(h, &Byte(buf, ofs), numbytes, &numwritten, NULL))
                 err = GetLastError();
         }
-        if (err) {
+        if (err == ERROR_BROKEN_PIPE) {
+            /* The write handle for an anonymous pipe has been closed. We match
+               the Unix behavior, and treat this as a zero-read instead of a
+               Unix_error. See OCaml PR #4790. */
+            numwritten = 0;
+        } else if (err) {
             win32_maperr(err);
             uerror("read", Nothing);
         }
diff --git a/src/unix/windows_c/windows_read_job.c b/src/unix/windows_c/windows_read_job.c
index b9a3b749b3..14864c9ea3 100644
--- a/src/unix/windows_c/windows_read_job.c
+++ b/src/unix/windows_c/windows_read_job.c
@@ -51,7 +51,12 @@ static value result_read(struct job_read *job)
 {
     value result;
     DWORD error = job->error_code;
-    if (error) {
+    if (error == ERROR_BROKEN_PIPE) {
+        /* The write handle for an anonymous pipe has been closed. We match the
+           Unix behavior, and treat this as a zero-read instead of a Unix_error.
+           See OCaml PR #4790. */
+        job->result = 0;
+    } else if (error) {
         caml_remove_generational_global_root(&job->string);
         lwt_unix_free_job(&job->job);
         win32_maperr(error);