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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
type lexer_output =
| Quoted of (string * string)
| Unquoted
| Error of string
exception Cant_parse_octal
let ascii_zero = 48
let octal_to_char c1 c2 c3 =
let char_to_digit c = Char.code c - ascii_zero in
try
Char.chr (
(char_to_digit c1 lsl 6) lor
(char_to_digit c2 lsl 3) lor
char_to_digit c3
)
with Invalid_argument _ -> raise Cant_parse_octal
let lex_quoted_char s len i =
match s.[i] with
| 'a' -> Some ('\007', 2)
| 'b' -> Some ('\b', 2)
| 'f' -> Some ('\012', 2)
| 'n' -> Some ('\n', 2)
| 'r' -> Some ('\r', 2)
| 't' -> Some ('\t', 2)
| 'v' -> Some ('\011', 2)
| '\\' -> Some ('\\', 2)
| '"' -> Some ('"', 2)
| '0'..'3' as c1 when len >= 3 ->
begin match s.[i + 1], s.[i + 2] with
| ('0'..'7' as c2), ('0'..'7' as c3) ->
(try Some (octal_to_char c1 c2 c3, 4)
with Cant_parse_octal -> None)
| _, _ -> None
end
| _ -> None
let rec lex_quoted_filename buf s len i =
if len > 0 then
match s.[i] with
| '"' -> Quoted (Buffer.contents buf, Lib.String.slice ~start:(i + 1) s)
| '\\' when len > 2 ->
let char_size =
match lex_quoted_char s (len - 1) (i + 1) with
| Some (c, char_size) -> Buffer.add_char buf c; char_size
| None -> Buffer.add_char buf s.[i]; 1
in
lex_quoted_filename buf s (len - char_size) (i + char_size)
| c ->
Buffer.add_char buf c;
lex_quoted_filename buf s (len - 1) (i + 1)
else
Unquoted
let lex_filename buf s len =
if len > 0 then
match s.[0] with
| '"' -> lex_quoted_filename buf s (len - 1) 1
| _ -> Unquoted
else
Error "empty filename"
let parse_filename ~allow_space s =
match lex_filename (Buffer.create 128) s (String.length s) with
| Quoted x -> Ok x
| Unquoted when not allow_space ->
begin match Lib.String.cut ' ' s with
| None -> Ok (s, "")
| Some x -> Ok x
end
| Unquoted -> Ok (s, "")
| Error msg -> Error msg
let parse s =
let filename_and_date =
match Lib.String.cut '\t' s with
| None ->
parse_filename ~allow_space:false s
| Some (filename, date) ->
match parse_filename ~allow_space:true filename with
| Ok (filename, "") -> Ok (filename, date)
| Ok _ -> Error "Unexpected character after closing double-quote"
| Error _ as err -> err
in
match filename_and_date with
| Ok (filename, date) ->
if filename = "/dev/null" ||
let date = String.trim date in
Lib.String.is_prefix ~prefix:"1970-" date ||
Lib.String.is_prefix ~prefix:"1969-" date ||
Lib.String.is_suffix ~suffix:" 1970" date ||
Lib.String.is_suffix ~suffix:" 1969" date then
Ok None
else
Ok (Some filename)
| Error _ as err -> err
let parse_git_filename s =
match parse_filename ~allow_space:true s with
| Ok (s, "") -> Ok s
| Ok _ -> Error "Unexpected character after closing double-quote in header"
| Error _ as err -> err
let ~from_ ~to_ s =
let rec loop ~s ~len i =
if i < (len : int) then
match String.unsafe_get s i with
| ' ' | '\t' ->
let a = parse_git_filename (Lib.String.slice ~stop:i s) in
let b = parse_git_filename (Lib.String.slice ~start:(i + 1) s) in
begin match a, b with
| Ok a, Ok b
when Lib.String.is_suffix ~suffix:from_ a &&
Lib.String.is_suffix ~suffix:to_ b
-> Some (a, b)
| Ok _, Ok _ | Error _, _ | _, Error _
-> loop ~s ~len (i + 1)
end
| _ -> loop ~s ~len (i + 1)
else
None
in
loop ~s ~len:(String.length s) 0
let s =
let rec loop ~best ~s ~len i =
if i < (len : int) then
match String.unsafe_get s i with
| ' ' | '\t' ->
let a = parse_git_filename (Lib.String.slice ~stop:i s) in
let b = parse_git_filename (Lib.String.slice ~start:(i + 1) s) in
begin match a, b with
| Ok a, Ok b ->
begin match best, Lib.String.count_common_suffix a b with
| None, best -> loop ~best:(Some (best, a, b)) ~s ~len (i + 1)
| Some (prev_best, _, _), best when best > (prev_best : int) ->
loop ~best:(Some (best, a, b)) ~s ~len (i + 1)
| Some _ as best, _ -> loop ~best ~s ~len (i + 1)
end
| Error _, _ | _, Error _ -> loop ~best ~s ~len (i + 1)
end
| _ -> loop ~best ~s ~len (i + 1)
else
match best with
| None -> None
| Some (_best, a, b) -> Some (a, b)
in
loop ~best:None ~s ~len:(String.length s) 0