package devkit

You can search for identifiers within the package.

in-package search v0.2.0

Development kit - general purpose library

Install

Dune Dependency

github.com Readme Edit opam file Versions (8)

Authors

A

Ahrefs <github@ahrefs.com>

Maintainers

I

igor@ahrefs.com

Sources

devkit-1.20210517.tbz

md5=00995ebead339d6ec1ba7859c3fc3a58

sha256=5ad39c7fa1a966a2f0a7f6dbb7e82c787439c73482f5f44b3c9fb54b040d36eb

sha512=8dd3f7d4aaabae9aa9ede13edee2b22214c0d2e2780bb08b2ca8ed588d74fc6d9b1908bb31dfee49c949c7cc425fb98897b8e0f11280070ebd99b965908ea133

doc/src/devkit.core/pid.ml.html

Source file `pid.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
open ExtLib
open Printf

type t = { host : string; id : int; name : string; stamp : int; }

let dummy = { host="*"; id=0; name="*"; stamp=0; }

let show { id; name; host; stamp=_; } = sprintf "%u:%s@%s" id name host
let to_string { id; name; host; stamp; } = sprintf "%u:%u:%s@%s" stamp id name host
let compare (pid1:t) pid2 = compare pid1 pid2
let equal pid1 pid2 = 0 = compare pid1 pid2
let name { name; _ } = name
let host { host; _ } = host

let get_name s = try fst @@ String.split s "." with _ -> s
let validate_name descr s =
  try Scanf.sscanf s "%_[a-zA-Z0-9_.-]%!" () with _ -> Exn.fail "Pid.self: bad %s %S" descr s
let sanitize_name = String.map (function 'a'..'z' | 'A'..'Z' | '0'..'9' | '_' | '-' | '.' as c -> c | _ -> '_')

let parse_exn s =
  (* cf self_pid *)
  Scanf.sscanf s "%u:%u:%[a-zA-Z0-9_.-]@@%[a-zA-Z0-9_.-]%!" (fun stamp id name host ->
   if host = "" then Exn.fail "empty hostname";
   if name = "" then Exn.fail "empty name";
   { id; host=String.lowercase host; name=get_name @@ String.lowercase name; stamp; })

let make ~id ~host ~stamp name =
  validate_name "name" name;
  validate_name "host" host;
  { id; host; stamp; name }

let new_self name stamp =
  let id = Unix.getpid () in
  let host = String.lowercase @@ Unix.gethostname () in
  (* cf parse_exn *)
  validate_name "host" host;
  validate_name "name" name;
  { host; id; name = get_name @@ String.lowercase name; stamp; }

let self = ref @@ dummy
let self_s = ref @@ ""

let assign_self t =
  self := t;
  self_s := show t

let update_self name fresh = assign_self @@ new_self name (if fresh then Time.(int @@ now ()) else (!self).stamp)

let () = update_self (sanitize_name @@ Filename.basename Sys.executable_name) true

let fake_id = ref false

let set_name name =
  validate_name "name" name;
  update_self name !fake_id;
  fake_id := false

let update () =
  match !fake_id with
  | true -> ()
  | false ->
  match (!self).id = Unix.getpid () with
  | true -> ()
  | false -> (* fork *)
    update_self (!self.name) true

let set_fake t =
  assign_self t;
  fake_id := true

let self () = update (); !self
let self_name () = name @@ self ()
let show_self () = update (); !self_s
let self_as name = set_name name; self ()