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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
open EzCompat
open EzFile.OP
let exit = Exit
let check_sharable file =
let basename = Filename.basename file in
match EzFile.cut_extension basename with
| basename, "" -> begin
match String.lowercase basename with
| "license"
| "changes"
| "meta"
| "opam"
| "dune-package" ->
true
| _ ->
match
let ic = open_in file in
let bytes = Bytes.create 256 in
let len = input ic bytes 0 256 in
for i = 0 to len -1 do
let c = int_of_char ( Bytes.get bytes i ) in
if c >= 128 then begin
close_in ic ;
raise exit
end
done;
close_in ic
with
| () ->
Printf.eprintf "check_sharable: false (no ext, no byte) for %s\n%!" file ;
false
| exception Exit -> true
end
| _, (
"exe" | "byte" | "opt" | "native"
| "a" | "so" | "o"
| "cmi" | "cma" | "cmo" | "cmx" | "cmxs" | "cmxa"
| "cmt" | "cmti"
| "ml" | "mli"
| "html" | "md" | "mld"
| "png" | "pdf"
| "h"
| "js" | "css"
| "el" | "vim"
| "1" | "3o" | "5"
| "cache" )
-> true
| _, ext ->
Printf.eprintf "check_sharable: false (ext %S) for %s\n%!" ext file ;
false
let share_file ~share_dir file =
match Digest.file file with
| exception exn ->
Misc.global_log "Sharing file %s: exception %s" file
( Printexc.to_string exn )
| md5 ->
Printf.eprintf "SHARING %s\n%!" file ;
let hex = Digest.to_hex md5 in
let dirname =
share_dir //
String.make 1 hex.[0] //
String.make 1 hex.[1] //
String.make 1 hex.[2]
in
let shared_file = dirname // ( hex ^ ".share" ) in
if Sys.file_exists shared_file then begin
try
Sys.remove file ;
Unix.link shared_file file
with exn ->
Printf.kprintf failwith "Sharing file %s: exception %s" file
( Printexc.to_string exn )
end else begin
EzFile.make_dir ~p:true dirname ;
Unix.link file shared_file
end
let files ?( share_dir = Globals.opambin_share_dir ) files =
EzFile.make_dir ~p:true share_dir ;
match Unix.stat share_dir with
| exception exn ->
Misc.global_log "Warning: sharing disabled, exception %s"
( Printexc.to_string exn )
| { Unix.st_dev = partition_dev ; _ } ->
List.iter (fun file ->
match Unix.lstat file with
| exception exn ->
Misc.global_log "Sharing file %s: error %s" file
( Printexc.to_string exn )
| st ->
if st.st_dev <> partition_dev then
Misc.global_log "Sharing file %s: other partition" file
else
match st.st_kind with
| S_REG ->
if check_sharable file then
share_file ~share_dir file
| _ -> ()
) files