1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(win32reg).
21
22-export([open/1, close/1,
23	 current_key/1, change_key/2, change_key_create/2,
24	 sub_keys/1, delete_key/1,
25	 value/2, values/1, set_value/3, delete_value/2,
26	 expand/1,
27	 format_error/1]).
28
29-export_type([reg_handle/0]).
30
31%% Key handles (always open).
32-define(hkey_classes_root, 16#80000000).
33-define(hkey_current_user, 16#80000001).
34-define(hkey_local_machine, 16#80000002).
35-define(hkey_users, 16#80000003).
36-define(hkey_performance_data, 16#80000004).
37-define(hkey_current_config, 16#80000005).
38-define(hkey_dyn_data, 16#80000006).
39
40%% Driver commands.
41-define(cmd_get_current, 0).
42-define(cmd_open_key, 1).
43-define(cmd_create_key, 2).
44-define(cmd_get_all_subkeys, 3).
45-define(cmd_get_value, 4).
46-define(cmd_get_all_values, 5).
47-define(cmd_set_value, 6).
48-define(cmd_delete_key, 7).
49-define(cmd_delete_value, 8).
50
51%% Data types.
52-define(reg_sc, 1).
53-define(reg_expand_sc, 2).
54-define(reg_binary, 3).
55-define(reg_dword, 4).
56
57%% Basic types internal to this file.
58-opaque reg_handle() :: {'win32reg',port()}.
59-type name()       :: string() | 'default'.
60-type value()      :: string() | integer() | binary().
61
62%%% Exported functions.
63
64-spec open(OpenModeList) -> ReturnValue when
65      OpenModeList :: [OpenMode],
66      OpenMode :: 'read' | 'write',
67      ReturnValue :: {'ok', RegHandle} | {'error', ErrorId :: 'enotsup'},
68      RegHandle :: reg_handle().
69
70open(Modes) ->
71    case os:type() of
72	{win32, _} ->
73	    case open_mode(Modes, []) of
74		{error, Reason} ->
75		    {error, Reason};
76		ModeStr ->
77		    P = open_port({spawn, "registry__drv__ " ++ ModeStr}, []),
78		    {ok, {win32reg, P}}
79	    end;
80	_ ->
81	    {error, enotsup}
82    end.
83
84-spec close(RegHandle) -> 'ok' when
85      RegHandle :: reg_handle().
86
87close({win32reg, Reg}) when is_port(Reg) ->
88    unlink(Reg),
89    exit(Reg, die),
90    ok.
91
92-spec current_key(RegHandle) -> ReturnValue when
93      RegHandle :: reg_handle(),
94      ReturnValue :: {'ok', string()}.
95
96current_key({win32reg, Reg}) when is_port(Reg) ->
97    Cmd = [?cmd_get_current],
98    Reg ! {self(), {command, Cmd}},
99    {state, Hkey, Name} = get_result(Reg),
100    Root = hkey_to_string(Hkey),
101    {ok, case Name of
102	     [] -> Root;
103	     _  -> Root ++ [$\\|Name]
104	 end}.
105
106-spec change_key(RegHandle, Key) -> ReturnValue when
107      RegHandle :: reg_handle(),
108      Key :: string(),
109      ReturnValue :: 'ok' | {'error', ErrorId :: atom()}.
110
111change_key({win32reg, Reg}, Key) when is_port(Reg) ->
112    change_key(Reg, ?cmd_open_key, Key).
113
114-spec change_key_create(RegHandle, Key) -> ReturnValue when
115      RegHandle :: reg_handle(),
116      Key :: string(),
117      ReturnValue :: 'ok' | {'error', ErrorId :: atom()}.
118
119change_key_create({win32reg, Reg}, Key) when is_port(Reg) ->
120    change_key(Reg, ?cmd_create_key, Key).
121
122change_key(Reg, Cmd, Key) ->
123    case parse_key(Key, Reg) of
124	{ok, Hkey, Path} ->
125	    Reg ! {self(), {command, [Cmd, i32(Hkey), Path, 0]}},
126	    get_result(Reg);
127	{error, Reason} ->
128	    {error, Reason}
129    end.
130
131-spec sub_keys(RegHandle) -> ReturnValue when
132      RegHandle :: reg_handle(),
133      ReturnValue :: {'ok', [SubKey]} | {'error', ErrorId :: atom()},
134      SubKey :: string().
135
136sub_keys({win32reg, Reg}) when is_port(Reg) ->
137    Cmd = [?cmd_get_all_subkeys],
138    Reg ! {self(), {command, Cmd}},
139    collect_keys(Reg, []).
140
141-spec delete_key(RegHandle) -> ReturnValue when
142      RegHandle :: reg_handle(),
143      ReturnValue :: 'ok' | {'error', ErrorId :: atom()}.
144
145delete_key({win32reg, Reg}) when is_port(Reg) ->
146    Cmd = [?cmd_get_current],
147    Reg ! {self(), {command, Cmd}},
148    case get_result(Reg) of
149	{state, _Hkey, []} ->
150	    {error, eperm};
151	{state, _Hkey, Rest} ->
152	    [Name|_] = split_key(Rest),
153	    ok = change_key(Reg, ?cmd_open_key, ".."),
154	    Cmd2 = [?cmd_delete_key],
155	    Reg ! {self(), {command, [Cmd2, Name, 0]}},
156	    get_result(Reg);
157	{error, Erorr} ->
158	    {error, Erorr}
159    end.
160
161-spec set_value(RegHandle, Name, Value) -> ReturnValue when
162      RegHandle :: reg_handle(),
163      Name :: name(),
164      Value :: value(),
165      ReturnValue :: 'ok' | {'error', ErrorId :: atom()}.
166
167set_value({win32reg, Reg}, Name0, Value) when is_port(Reg) ->
168    Name =
169	case Name0 of
170	    default -> [];
171	    _ -> Name0
172	end,
173    {Type, V} = term_to_value(Value),
174    Cmd = [?cmd_set_value, Type, Name, 0, V],
175    Reg ! {self(), {command, Cmd}},
176    get_result(Reg).
177
178-spec value(RegHandle, Name) -> ReturnValue when
179      RegHandle :: reg_handle(),
180      Name :: name(),
181      ReturnValue :: {'ok', Value :: value()} | {'error', ErrorId :: atom()}.
182
183value({win32reg, Reg}, Name0) when is_port(Reg) ->
184    Name =
185	case Name0 of
186	    default -> [];
187	    _ -> Name0
188	end,
189    Cmd = [?cmd_get_value, Name, 0],
190    Reg ! {self(), {command, Cmd}},
191    case get_result(Reg) of
192	{value, {default, Value}} when Name =:= [] ->
193	    {ok, Value};
194	{value, {Name, Value}} ->
195	    {ok, Value};
196	{error, Reason} ->
197	    {error, Reason}
198    end.
199
200-spec values(RegHandle) -> ReturnValue when
201      RegHandle :: reg_handle(),
202      ReturnValue :: {'ok', [ValuePair]} | {'error', ErrorId :: atom()},
203      ValuePair :: {Name :: name(), Value :: value()}.
204
205values({win32reg, Reg}) when is_port(Reg) ->
206    Cmd = [?cmd_get_all_values],
207    Reg ! {self(), {command, Cmd}},
208    collect_values(Reg, []).
209
210-spec delete_value(RegHandle, Name) -> ReturnValue when
211      RegHandle :: reg_handle(),
212      Name :: name(),
213      ReturnValue :: 'ok' | {'error', ErrorId :: atom()}.
214
215delete_value({win32reg, Reg}, Name0) when is_port(Reg) ->
216    Name =
217	case Name0 of
218	    default -> [];
219	    _ -> Name0
220	end,
221    Cmd = [?cmd_delete_value, Name, 0],
222    Reg ! {self(), {command, Cmd}},
223    get_result(Reg).
224
225-spec expand(String) -> ExpandedString when
226      String :: string(),
227      ExpandedString :: string().
228
229expand(Value) ->
230    expand(Value, [], []).
231
232expand([$%, $%|Rest], [], Result) ->
233    expand(Rest, [], [$%|Result]);
234expand([$%, C|Rest], [], Result) ->
235    expand(Rest, [C], Result);
236expand([C|Rest], [], Result) ->
237    expand(Rest, [], [C|Result]);
238expand([$%|Rest], Env0, Result) ->
239    Env = lists:reverse(Env0),
240    expand(Rest, [], lists:reverse(os:getenv(Env, ""))++Result);
241expand([C|Rest], Env, Result) ->
242    expand(Rest, [C|Env], Result);
243expand([], [], Result) ->
244    lists:reverse(Result).
245
246-spec format_error(ErrorId) -> ErrorString when
247      ErrorId :: atom(),
248      ErrorString :: string().
249
250format_error(ErrorId) ->
251    erl_posix_msg:message(ErrorId).
252
253%%% Implementation.
254
255-spec collect_values(port(), [{name(), value()}]) ->
256        {'ok', [{name(), value()}]} | {'error', ErrorId :: atom()}.
257
258collect_values(P, Result) ->
259    case get_result(P) of
260	ok ->
261	    {ok, lists:reverse(Result)};
262	{value, ValueData} ->
263	    collect_values(P, [ValueData|Result]);
264	{error, Reason} ->
265	    {error, Reason}
266    end.
267
268-spec collect_keys(port(), string()) -> {'ok', [string()]} | {'error', ErrorId :: atom()}.
269
270collect_keys(P, Result) ->
271    case get_result(P) of
272	ok ->
273	    {ok, lists:reverse(Result)};
274	{key, KeyData} ->
275	    collect_keys(P, [KeyData|Result]);
276	{error, Reason} ->
277	    {error, Reason}
278    end.
279
280get_result(P) ->
281    receive
282	{P, {data, Data}} ->
283	    get_result1(Data)
284    end.
285
286get_result1([$e|Reason]) ->
287    {error, list_to_atom(Reason)};
288get_result1([$o]) ->
289    ok;
290get_result1([$k|Name]) ->
291    {key, Name};
292get_result1([$v|Rest0]) ->
293    {ok, Type, Rest1} = i32_on_head(Rest0),
294    {ok, Name0, Value} = get_cstring(Rest1),
295    Name =
296	case Name0 of
297	    [] -> default;
298	    _ ->  Name0
299	end,
300    {value, {Name, encode_value(Type, Value)}};
301get_result1([$s|Rest0]) ->
302    {ok, Hkey, Name} = i32_on_head(Rest0),
303    {state, Hkey, Name}.
304
305encode_value(?reg_sc, Value) ->
306    Value;
307encode_value(?reg_expand_sc, Value) ->
308    Value;
309encode_value(?reg_dword, Value) ->
310    i32(Value);
311encode_value(_, Value) ->
312    list_to_binary(Value).
313
314term_to_value(Int) when is_integer(Int) ->
315    {i32(?reg_dword), i32(Int)};
316term_to_value(String) when is_list(String) ->
317    {i32(?reg_sc), [String, 0]};
318term_to_value(Bin) when is_binary(Bin) ->
319    {i32(?reg_binary), Bin};
320term_to_value(_) ->
321    exit(badarg).
322
323get_cstring(List) ->
324    get_cstring(List, []).
325
326get_cstring([0|Rest], Result) ->
327    {ok, lists:reverse(Result), Rest};
328get_cstring([C|Rest], Result) ->
329    get_cstring(Rest, [C|Result]);
330get_cstring([], Result) ->
331    {ok, lists:reverse(Result), []}.
332
333i32(Int) when is_integer(Int) ->
334    [(Int bsr 24) band 255,
335     (Int bsr 16) band 255,
336     (Int bsr  8) band 255,
337     Int band 255];
338i32([X1, X2, X3, X4]) ->
339    (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4.
340
341i32_on_head([X1, X2, X3, X4 | Rest]) ->
342    {ok, (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4, Rest}.
343
344parse_key([$\\|Rest], _) ->
345    parse_root(Rest, []);
346parse_key(Key, Reg) ->
347    parse_relative(Key, Reg).
348
349parse_relative(Path, Reg) ->
350    Cmd = [?cmd_get_current],
351    Reg ! {self(), {command, Cmd}},
352    {state, RootHandle, Name} = get_result(Reg),
353    Original = split_key(Name),
354    Relative = lists:reverse(split_key(Path)),
355    case parse_relative1(Relative, Original) of
356	{error,Error} ->
357	    {error,Error};
358	NewPath ->
359	    {ok, RootHandle, NewPath}
360    end.
361
362parse_relative1([".."|_], []) ->
363    {error,enoent};
364parse_relative1([".."|T1], [_|T2]) ->
365    parse_relative1(T1, T2);
366parse_relative1([Comp|Rest], Result) ->
367    parse_relative1(Rest, [Comp|Result]);
368parse_relative1([], Result) ->
369    reverse_and_join(Result, []).
370
371reverse_and_join([X|Rest], []) ->
372    reverse_and_join(Rest, [X]);
373reverse_and_join([X|Rest], Result) ->
374    reverse_and_join(Rest, [X, "\\" | Result]);
375reverse_and_join([], Result) ->
376    Result.
377
378split_key(Key) ->
379    split_key(Key, [], []).
380
381split_key([$\\|Rest], Current, Result) ->
382    split_key(Rest, [], [lists:reverse(Current)|Result]);
383split_key([C|Rest], Current, Result) ->
384    split_key(Rest, [C|Current], Result);
385split_key([], [], Result) ->
386    Result;
387split_key([], Current, Result) ->
388    [lists:reverse(Current)|Result].
389
390parse_root([$\\|Rest], Result) ->
391    Root =
392	case lists:reverse(Result) of
393	    [$h, $k, $e, $y, $_|Root0] ->
394		Root0;
395	    Root0 ->
396		Root0
397	end,
398    case root_to_handle(list_to_atom(Root)) of
399	false ->
400	    {error, enoent};
401	Handle ->
402	    {ok, Handle, Rest}
403    end;
404parse_root([C|Rest], Result) ->
405    parse_root(Rest, [C|Result]);
406parse_root([], Result) ->
407    parse_root([$\\], Result).
408
409root_to_handle(classes_root) -> ?hkey_classes_root;
410root_to_handle(hkcr) -> ?hkey_classes_root;
411root_to_handle(current_user) -> ?hkey_current_user;
412root_to_handle(hkcu) -> ?hkey_current_user;
413root_to_handle(local_machine) -> ?hkey_local_machine;
414root_to_handle(hklm) -> ?hkey_local_machine;
415root_to_handle(users) -> ?hkey_users;
416root_to_handle(hku) -> ?hkey_users;
417root_to_handle(current_config) -> ?hkey_current_config;
418root_to_handle(hkcc) -> ?hkey_current_config;
419root_to_handle(dyn_data) -> ?hkey_dyn_data;
420root_to_handle(hkdd) -> ?hkey_dyn_data;
421root_to_handle(performance_data) -> ?hkey_performance_data;
422root_to_handle(_) -> false.
423
424hkey_to_string(?hkey_classes_root) -> "\\hkey_classes_root";
425hkey_to_string(?hkey_current_user) -> "\\hkey_current_user";
426hkey_to_string(?hkey_local_machine) -> "\\hkey_local_machine";
427hkey_to_string(?hkey_users) -> "\\hkey_users";
428hkey_to_string(?hkey_performance_data) -> "\\hkey_performance_data";
429hkey_to_string(?hkey_current_config) -> "\\hkey_current_config";
430hkey_to_string(?hkey_dyn_data) -> "\\hkey_dyn_data".
431
432open_mode([read|Rest], Result) ->
433    open_mode(Rest, [$r|Result]);
434open_mode([write|Rest], Result) ->
435    open_mode(Rest, [$w|Result]);
436open_mode([], Result) ->
437    Result;
438open_mode(_, _) ->
439    {error, einval}.
440