diff options
Diffstat (limited to 'lib/stdlib/src/win32reg.erl')
| -rw-r--r-- | lib/stdlib/src/win32reg.erl | 386 |
1 files changed, 386 insertions, 0 deletions
diff --git a/lib/stdlib/src/win32reg.erl b/lib/stdlib/src/win32reg.erl new file mode 100644 index 0000000000..ee0d17bc94 --- /dev/null +++ b/lib/stdlib/src/win32reg.erl @@ -0,0 +1,386 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(win32reg). + +-export([open/1, close/1, + current_key/1, change_key/2, change_key_create/2, + sub_keys/1, delete_key/1, + value/2, values/1, set_value/3, delete_value/2, + expand/1, + format_error/1]). + +%% Key handles (always open). +-define(hkey_classes_root, 16#80000000). +-define(hkey_current_user, 16#80000001). +-define(hkey_local_machine, 16#80000002). +-define(hkey_users, 16#80000003). +-define(hkey_performance_data, 16#80000004). +-define(hkey_current_config, 16#80000005). +-define(hkey_dyn_data, 16#80000006). + +%% Driver commands. +-define(cmd_get_current, 0). +-define(cmd_open_key, 1). +-define(cmd_create_key, 2). +-define(cmd_get_all_subkeys, 3). +-define(cmd_get_value, 4). +-define(cmd_get_all_values, 5). +-define(cmd_set_value, 6). +-define(cmd_delete_key, 7). +-define(cmd_delete_value, 8). + +%% Data types. +-define(reg_sc, 1). +-define(reg_expand_sc, 2). +-define(reg_binary, 3). +-define(reg_dword, 4). + +%% Basic types internal to this file. +-type open_mode() :: 'read' | 'write'. +-type reg_handle() :: {'win32reg',port()}. +-type name() :: string() | 'default'. +-type value() :: string() | integer() | binary(). + +%%% Exported functions. + +-spec open([open_mode()]) -> {'ok', reg_handle()} | {'error', 'enotsup'}. + +open(Modes) -> + case os:type() of + {win32, _} -> + case open_mode(Modes, []) of + {error, Reason} -> + {error, Reason}; + ModeStr -> + P = open_port({spawn, "registry__drv__ " ++ ModeStr}, []), + {ok, {win32reg, P}} + end; + _ -> + {error, enotsup} + end. + +-spec close(reg_handle()) -> 'ok'. + +close({win32reg, Reg}) when is_port(Reg) -> + unlink(Reg), + exit(Reg, die), + ok. + +-spec current_key(reg_handle()) -> {'ok', string()}. + +current_key({win32reg, Reg}) when is_port(Reg) -> + Cmd = [?cmd_get_current], + Reg ! {self(), {command, Cmd}}, + {state, Hkey, Name} = get_result(Reg), + Root = hkey_to_string(Hkey), + {ok, case Name of + [] -> Root; + _ -> Root ++ [$\\|Name] + end}. + +-spec change_key(reg_handle(), string()) -> 'ok' | {'error', atom()}. + +change_key({win32reg, Reg}, Key) when is_port(Reg) -> + change_key(Reg, ?cmd_open_key, Key). + +-spec change_key_create(reg_handle(), string()) -> 'ok' | {'error', atom()}. + +change_key_create({win32reg, Reg}, Key) when is_port(Reg) -> + change_key(Reg, ?cmd_create_key, Key). + +change_key(Reg, Cmd, Key) -> + case parse_key(Key, Reg) of + {ok, Hkey, Path} -> + Reg ! {self(), {command, [Cmd, i32(Hkey), Path, 0]}}, + get_result(Reg); + {error, Reason} -> + {error, Reason} + end. + +-spec sub_keys(reg_handle()) -> {'ok', [string()]} | {'error', atom()}. + +sub_keys({win32reg, Reg}) when is_port(Reg) -> + Cmd = [?cmd_get_all_subkeys], + Reg ! {self(), {command, Cmd}}, + collect_keys(Reg, []). + +-spec delete_key(reg_handle()) -> 'ok' | {'error', atom()}. + +delete_key({win32reg, Reg}) when is_port(Reg) -> + Cmd = [?cmd_delete_key], + Reg ! {self(), {command, Cmd}}, + get_result(Reg). + +-spec set_value(reg_handle(), name(), value()) -> 'ok' | {'error', atom()}. + +set_value({win32reg, Reg}, Name0, Value) when is_port(Reg) -> + Name = + case Name0 of + default -> []; + _ -> Name0 + end, + {Type, V} = term_to_value(Value), + Cmd = [?cmd_set_value, Type, Name, 0, V], + Reg ! {self(), {command, Cmd}}, + get_result(Reg). + +-spec value(reg_handle(), name()) -> {'ok', value()} | {'error', atom()}. + +value({win32reg, Reg}, Name) when is_port(Reg) -> + Cmd = [?cmd_get_value, Name, 0], + Reg ! {self(), {command, Cmd}}, + case get_result(Reg) of + {value, {Name, Value}} -> + {ok, Value}; + {error, Reason} -> + {error, Reason} + end. + +-spec values(reg_handle()) -> {'ok', [{name(), value()}]} | {'error', atom()}. + +values({win32reg, Reg}) when is_port(Reg) -> + Cmd = [?cmd_get_all_values], + Reg ! {self(), {command, Cmd}}, + collect_values(Reg, []). + +-spec delete_value(reg_handle(), name()) -> 'ok' | {'error', atom()}. + +delete_value({win32reg, Reg}, Name0) when is_port(Reg) -> + Name = + case Name0 of + default -> []; + _ -> Name0 + end, + Cmd = [?cmd_delete_value, Name, 0], + Reg ! {self(), {command, Cmd}}, + get_result(Reg). + +-spec expand(string()) -> string(). + +expand(Value) -> + expand(Value, [], []). + +expand([$%, $%|Rest], [], Result) -> + expand(Rest, [], [$%|Result]); +expand([$%, C|Rest], [], Result) -> + expand(Rest, [C], Result); +expand([C|Rest], [], Result) -> + expand(Rest, [], [C|Result]); +expand([$%|Rest], Env0, Result) -> + Env = lists:reverse(Env0), + case os:getenv(Env) of + false -> + expand(Rest, [], Result); + Value -> + expand(Rest, [], lists:reverse(Value)++Result) + end; +expand([C|Rest], Env, Result) -> + expand(Rest, [C|Env], Result); +expand([], [], Result) -> + lists:reverse(Result). + +-spec format_error(atom()) -> string(). + +format_error(ErrorId) -> + erl_posix_msg:message(ErrorId). + +%%% Implementation. + +-spec collect_values(port(), [{name(), value()}]) -> + {'ok', [{name(), value()}]} | {'error', atom()}. + +collect_values(P, Result) -> + case get_result(P) of + ok -> + {ok, lists:reverse(Result)}; + {value, ValueData} -> + collect_values(P, [ValueData|Result]); + {error, Reason} -> + {error, Reason} + end. + +-spec collect_keys(port(), string()) -> {'ok', [string()]} | {'error', atom()}. + +collect_keys(P, Result) -> + case get_result(P) of + ok -> + {ok, lists:reverse(Result)}; + {key, KeyData} -> + collect_keys(P, [KeyData|Result]); + {error, Reason} -> + {error, Reason} + end. + +get_result(P) -> + receive + {P, {data, Data}} -> + get_result1(Data) + end. + +get_result1([$e|Reason]) -> + {error, list_to_atom(Reason)}; +get_result1([$o]) -> + ok; +get_result1([$k|Name]) -> + {key, Name}; +get_result1([$v|Rest0]) -> + {ok, Type, Rest1} = i32_on_head(Rest0), + {ok, Name0, Value} = get_cstring(Rest1), + Name = + case Name0 of + [] -> default; + _ -> Name0 + end, + {value, {Name, encode_value(Type, Value)}}; +get_result1([$s|Rest0]) -> + {ok, Hkey, Name} = i32_on_head(Rest0), + {state, Hkey, Name}. + +encode_value(?reg_sc, Value) -> + Value; +encode_value(?reg_expand_sc, Value) -> + Value; +encode_value(?reg_dword, Value) -> + i32(Value); +encode_value(_, Value) -> + list_to_binary(Value). + +term_to_value(Int) when is_integer(Int) -> + {i32(?reg_dword), i32(Int)}; +term_to_value(String) when is_list(String) -> + {i32(?reg_sc), [String, 0]}; +term_to_value(Bin) when is_binary(Bin) -> + {i32(?reg_binary), Bin}; +term_to_value(_) -> + exit(badarg). + +get_cstring(List) -> + get_cstring(List, []). + +get_cstring([0|Rest], Result) -> + {ok, lists:reverse(Result), Rest}; +get_cstring([C|Rest], Result) -> + get_cstring(Rest, [C|Result]); +get_cstring([], Result) -> + {ok, lists:reverse(Result), []}. + +i32(Int) when is_integer(Int) -> + [(Int bsr 24) band 255, + (Int bsr 16) band 255, + (Int bsr 8) band 255, + Int band 255]; +i32([X1, X2, X3, X4]) -> + (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4. + +i32_on_head([X1, X2, X3, X4 | Rest]) -> + {ok, (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4, Rest}. + +parse_key([$\\|Rest], _) -> + parse_root(Rest, []); +parse_key(Key, Reg) -> + parse_relative(Key, Reg). + +parse_relative(Path, Reg) -> + Cmd = [?cmd_get_current], + Reg ! {self(), {command, Cmd}}, + {state, RootHandle, Name} = get_result(Reg), + Original = split_key(Name), + Relative = lists:reverse(split_key(Path)), + case parse_relative1(Relative, Original) of + NewPath -> + {ok, RootHandle, NewPath} + %% XXX Error handling. + end. + +parse_relative1([".."|T1], [_|T2]) -> + parse_relative1(T1, T2); +parse_relative1([Comp|Rest], Result) -> + parse_relative1(Rest, [Comp|Result]); +parse_relative1([], Result) -> + reverse_and_join(Result, []). + +reverse_and_join([X|Rest], []) -> + reverse_and_join(Rest, [X]); +reverse_and_join([X|Rest], Result) -> + reverse_and_join(Rest, [X, "\\" | Result]); +reverse_and_join([], Result) -> + Result. + +split_key(Key) -> + split_key(Key, [], []). + +split_key([$\\|Rest], Current, Result) -> + split_key(Rest, [], [lists:reverse(Current)|Result]); +split_key([C|Rest], Current, Result) -> + split_key(Rest, [C|Current], Result); +split_key([], [], Result) -> + Result; +split_key([], Current, Result) -> + [lists:reverse(Current)|Result]. + +parse_root([$\\|Rest], Result) -> + Root = + case lists:reverse(Result) of + [$h, $k, $e, $y, $_|Root0] -> + Root0; + Root0 -> + Root0 + end, + case root_to_handle(list_to_atom(Root)) of + false -> + {error, enoent}; + Handle -> + {ok, Handle, Rest} + end; +parse_root([C|Rest], Result) -> + parse_root(Rest, [C|Result]); +parse_root([], Result) -> + parse_root([$\\], Result). + +root_to_handle(classes_root) -> ?hkey_classes_root; +root_to_handle(hkcr) -> ?hkey_classes_root; +root_to_handle(current_user) -> ?hkey_current_user; +root_to_handle(hkcu) -> ?hkey_current_user; +root_to_handle(local_machine) -> ?hkey_local_machine; +root_to_handle(hklm) -> ?hkey_local_machine; +root_to_handle(users) -> ?hkey_users; +root_to_handle(hku) -> ?hkey_users; +root_to_handle(current_config) -> ?hkey_current_config; +root_to_handle(hkcc) -> ?hkey_current_config; +root_to_handle(dyn_data) -> ?hkey_dyn_data; +root_to_handle(hkdd) -> ?hkey_dyn_data; +root_to_handle(performance_data) -> ?hkey_performance_data; +root_to_handle(_) -> false. + +hkey_to_string(?hkey_classes_root) -> "\\hkey_classes_root"; +hkey_to_string(?hkey_current_user) -> "\\hkey_current_user"; +hkey_to_string(?hkey_local_machine) -> "\\hkey_local_machine"; +hkey_to_string(?hkey_users) -> "\\hkey_users"; +hkey_to_string(?hkey_performance_data) -> "\\hkey_performance_data"; +hkey_to_string(?hkey_current_config) -> "\\hkey_current_config"; +hkey_to_string(?hkey_dyn_data) -> "\\hkey_dyn_data". + +open_mode([read|Rest], Result) -> + open_mode(Rest, [$r|Result]); +open_mode([write|Rest], Result) -> + open_mode(Rest, [$w|Result]); +open_mode([], Result) -> + Result; +open_mode(_, _) -> + {error, einval}. |