v0.12-preview.120.18+252

LICENSE.md

@@ -1,6 +1,6 @@
 The MIT License
 
-Copyright (c) 2008--2018 Jane Street Group, LLC <opensource@janestreet.com>
+Copyright (c) 2008--2019 Jane Street Group, LLC <opensource@janestreet.com>
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal

Makefile

@@ -1,18 +1,17 @@
 INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),)
 
-# Default rule
 default:
-	jbuilder build @install
+	dune build
 
 install:
-	jbuilder install $(INSTALL_ARGS)
+	dune install $(INSTALL_ARGS)
 
 uninstall:
-	jbuilder uninstall $(INSTALL_ARGS)
+	dune uninstall $(INSTALL_ARGS)
 
 reinstall: uninstall install
 
 clean:
-	rm -rf _build
+	dune clean
 
 .PHONY: default install uninstall reinstall clean

bench/bin/dune

@@ -0,0 +1,6 @@
+(executables
+ (names array_iter bench_hashtbl bench_heap bench_map bench_nano_mutex
+  core_stack core_string_search_pattern dequeue ordering_container
+  string_escaping time_to_string zone_next_clock_shift)
+ (libraries core core_bench pcre re2 shell.string_extended)
+ (preprocess (pps ppx_jane)))

bigbuffer_blocking/src/dune

@@ -0,0 +1,2 @@
+(library (name bigbuffer_blocking) (public_name core.bigbuffer_blocking)
+ (libraries core) (preprocess (pps ppx_jane)))

core.opam

@@ -1,27 +1,25 @@
-opam-version: "1.2"
+opam-version: "2.0"
 maintainer: "opensource@janestreet.com"
 authors: ["Jane Street Group, LLC <opensource@janestreet.com>"]
 homepage: "https://github.com/janestreet/core"
 bug-reports: "https://github.com/janestreet/core/issues"
 dev-repo: "git+https://github.com/janestreet/core.git"
+doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/core/index.html"
 license: "MIT"
 build: [
-  ["jbuilder" "build" "-p" name "-j" jobs]
+  ["dune" "build" "-p" name "-j" jobs]
 ]
 depends: [
+  "ocaml" {>= "4.07.0"}
   "core_kernel"
   "ppx_jane"
   "sexplib"
   "base-threads"
-  "jbuilder"                {build & >= "1.0+beta18.1"}
-  "ocaml-migrate-parsetree" {>= "1.0"}
-  "ppxlib"                  {>= "0.1.0"}
-  "spawn"                   {>= "v0.12"}
+  "dune"         {build & >= "1.5.1"}
+  "spawn"        {>= "v0.12"}
 ]
-available: [ ocaml-version >= "4.06.1" ]
-descr: "
-Industrial strength alternative to OCaml's standard library
-
+synopsis: "Industrial strength alternative to OCaml's standard library"
+description: "
 The Core suite of libraries is an industrial strength alternative to
 OCaml's standard library that was developed by Jane Street, the
 largest industrial user of OCaml.

daemon/src/dune

@@ -0,0 +1,2 @@
+(library (name daemon) (public_name core.daemon) (libraries core)
+ (preprocess (pps ppx_jane)))

daemon/test-bin/dune

@@ -0,0 +1,5 @@
+(alias (name runtest) (deps daemonize_test.exe)
+ (action (bash ./daemonize_test.exe)))
+
+(executables (names daemonize_test) (libraries daemon)
+ (preprocess (pps ppx_jane)))

dune

@@ -0,0 +1 @@
+(install (section bin) (files coretop corebuild))

dune-project

@@ -0,0 +1 @@
+(lang dune 1.5)

example/command/dune

@@ -0,0 +1,2 @@
+(executables (names main main_no_recur)
+ (libraries async core fieldslib sexplib) (preprocess (pps ppx_jane)))

example/command/main_no_recur.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

example/quickcheck/dune

@@ -0,0 +1,2 @@
+(library (name quickcheck_examples) (libraries core async)
+ (preprocess (pps ppx_jane)))

example/unix/dune

@@ -0,0 +1,2 @@
+(executables (names gettid getifaddrs) (libraries async core)
+ (preprocess (pps ppx_jane)))

lock_file_blocking/src/dune

@@ -0,0 +1,5 @@
+(library (name lock_file_blocking) (public_name core.lock_file_blocking)
+ (libraries core) (preprocessor_deps config.h) (preprocess (pps ppx_jane)))
+
+(rule (targets config.h) (deps)
+ (action (bash "cp %{lib:core:config.h} %{targets}")))

lock_file_blocking/src/lock_file_blocking.ml

@@ -340,3 +340,66 @@ module Nfs = struct
 
   let unlock path = Or_error.try_with (fun () -> unlock_exn path)
 end
+
+(* The reason this function is used is to make sure the file the path is pointing to
+   remains stable across [chdir]. In fact we'd prefer for it to remain stable over
+   other things, such as [rename] of a parent directory.
+   That could be achieved if we [open] the [dir] and use the resulting file descriptor
+   with linkat, unlinkat, etc system calls, but that's less portable and most
+   programs that use locks will break anyway if their directory is renamed. *)
+let canonicalize_dirname path =
+  let dir, name = Filename.dirname path, Filename.basename path in
+  let dir = Filename.realpath dir in
+  dir ^/ name
+
+module Mkdir = struct
+  type t = Locked of { lock_path : string }
+
+  let lock_exn ~lock_path =
+    let lock_path = canonicalize_dirname lock_path in
+    match Unix.mkdir lock_path with
+    | exception (Core.Unix.Unix_error (EEXIST, _, _)) -> `Somebody_else_took_it
+    | () -> `We_took_it (Locked { lock_path })
+
+  let unlock_exn (Locked { lock_path }) = Unix.rmdir lock_path
+end
+
+module Symlink = struct
+  type t = Locked of { lock_path : string }
+
+  let lock_exn ~lock_path ~metadata =
+    let lock_path = canonicalize_dirname lock_path in
+    match Unix.symlink ~link_name:lock_path ~target:metadata with
+    | exception (Core.Unix.Unix_error (EEXIST, _, _)) ->
+      `Somebody_else_took_it (Or_error.try_with (fun () -> Unix.readlink lock_path))
+    | () -> `We_took_it (Locked { lock_path })
+
+  let unlock_exn (Locked { lock_path }) = Unix.unlink lock_path
+end
+
+module Flock = struct
+
+  type t = {
+    fd : Caml.Unix.file_descr;
+    mutable unlocked : bool;
+  }
+
+  let lock_exn ~lock_path =
+    let fd =
+      Core.Unix.openfile ~perm:0o664 ~mode:[O_CREAT; O_WRONLY; O_CLOEXEC] lock_path
+    in
+    match flock fd with
+    | false ->
+      Core.Unix.close ~restart:true fd;
+      `Somebody_else_took_it
+    | true -> `We_took_it { fd; unlocked = false }
+    | exception exn ->
+      Core.Unix.close ~restart:true fd;
+      raise exn
+
+  let unlock_exn t =
+    if t.unlocked
+    then raise_s [%sexp "Lock_file_blocking.Flock.unlock_exn called twice"];
+    t.unlocked <- true;
+    Core.Unix.close ~restart:true t.fd;
+end

lock_file_blocking/src/lock_file_blocking.mli

@@ -1,8 +1,10 @@
 (** Mutual exclusion between processes using flock and lockf.  A file is considered locked
     only if both of these mechanisms work.
 
-    These locks are OS-level and as such are local to the machine and will not work across
-    computers even if they mount the same directory.
+    These locks are advisory, meaning that they will not work with systems that don't also
+    try to acquire the matching locks. Although lockf can work across systems (and, in our
+    environment, does work across Linux systems), it is not guaranteed to do so across all
+    implementations.
 *)
 
 open! Core
@@ -147,3 +149,80 @@ module Nfs : sig
   val unlock_exn : string -> unit
   val unlock     : string -> unit Or_error.t
 end
+
+(** This is the dumbest lock imaginable: we [mkdir] to lock and [rmdir] to unlock.
+    This gives you pretty good mutual exclusion, but it makes you vulnerable to
+    stale locks. *)
+module Mkdir : sig
+  type t
+
+  (** Raises an exception if the [mkdir] system call fails for any reason other than
+      [EEXIST]. *)
+  val lock_exn : lock_path:string -> [`We_took_it of t | `Somebody_else_took_it]
+
+  (** Raises an exception if the [rmdir] system call fails. *)
+  val unlock_exn : t -> unit
+end
+
+(** This is a bit better than [Mkdir] and is very likely to be compatible: it lets you
+    atomically write the owner of the lock into the symlink, it's used both by emacs and
+    hg, and it's supposed to work on nfs. *)
+module Symlink : sig
+  type t
+
+  (** [metadata] should include some information to help the user identify
+      the lock holder. Usually it's the pid of the holder, but if you use this
+      across a fork or take the lock multiple times in the same program,
+      then some extra information could be useful.
+      This string will be saved as the target of a (usually dangling) symbolic link
+      at path [lock_path].
+
+      [`Somebody_else_took_it] returns the metadata of the process who took it
+      or an error if that can't be determined (for example: they released the lock by the
+      time we tried to inspect it)
+
+      Raises an exception if taking the lock fails for any reason other than somebody
+      else holding the lock.
+  *)
+  val lock_exn :
+    lock_path:string -> metadata:string
+    -> [`We_took_it of t | `Somebody_else_took_it of (string Or_error.t) ]
+
+  val unlock_exn : t -> unit
+end
+
+(** This just uses [flock].
+    The main reason this module exists is that [create] won't let you release locks,
+    so we need a new interface.
+
+    Another difference is that implementation is simpler because it omits some of
+    the features, such as
+
+    1. Unlinking on exit.
+    That seems unsafe. Consider the following scenario:
+    - both a and b create and open the file
+    - a locks, unlinks and unlocks it
+    - b locks and stays in critical section
+    - c finds that there is no file, creates a new one, locks it and enters
+      critical section
+      You end up with b and c in the critical section together!
+
+    2. Writing pid or message in the file.
+    The file is shared between multiple processes so this feature seems hard to
+    think about, and it already lead to weird code. Let's just remove it.
+    You can still find who holds the file open by inspecting output of [lsof].
+
+    3. [close_on_exec = false]
+    There is no objective reason to omit that, but I can't think of a reason to support
+    it either.
+*)
+module Flock : sig
+  type t
+
+  (** Raises an exception if taking the lock fails for any reason other than somebody else
+      holding the lock. *)
+  val lock_exn : lock_path:string -> [ `We_took_it of t | `Somebody_else_took_it ]
+
+  (** Raises an exception if this lock was already unlocked earlier. *)
+  val unlock_exn : t -> unit
+end

lock_file_blocking/test-bin/dune

@@ -0,0 +1,2 @@
+(executables (names test_lock_file_blocking) (libraries lock_file_blocking)
+ (preprocess (pps ppx_jane)))