← Back to branch summary

~ubuntu-branches/ubuntu/lucid/rabbitmq-server/lucid

« back to all changes in this revision

Viewing changes to src/rabbit_misc.erl

  • Committer: Bazaar Package Importer
  • Author(s): John Leuner
  • Date: 2010-02-19 17:30:57 UTC
  • mfrom: (0.1.9 sid)
  • Revision ID: james.westby@ubuntu.com-20100219173057-84hlnj2bsm1rvoaf
Tags: 1.7.2-1
New upstream release

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/rabbit_misc.erl
18
18
%%   are Copyright (C) 2007-2008 LShift Ltd, Cohesive Financial
19
19
%%   Technologies LLC, and Rabbit Technologies Ltd.
20
20
%%
21
 
%%   Portions created by LShift Ltd are Copyright (C) 2007-2009 LShift
 
21
%%   Portions created by LShift Ltd are Copyright (C) 2007-2010 LShift
22
22
%%   Ltd. Portions created by Cohesive Financial Technologies LLC are
23
 
%%   Copyright (C) 2007-2009 Cohesive Financial Technologies
 
23
%%   Copyright (C) 2007-2010 Cohesive Financial Technologies
24
24
%%   LLC. Portions created by Rabbit Technologies Ltd are Copyright
25
 
%%   (C) 2007-2009 Rabbit Technologies Ltd.
 
25
%%   (C) 2007-2010 Rabbit Technologies Ltd.
26
26
%%
27
27
%%   All Rights Reserved.
28
28
%%
47
47
-export([with_user/2, with_vhost/2, with_user_and_vhost/3]).
48
48
-export([execute_mnesia_transaction/1]).
49
49
-export([ensure_ok/2]).
50
 
-export([localnode/1, nodehost/1, cookie_hash/0, tcp_name/3]).
 
50
-export([makenode/1, nodeparts/1, cookie_hash/0, tcp_name/3]).
51
51
-export([intersperse/2, upmap/2, map_in_order/2]).
52
52
-export([table_foreach/2]).
53
53
-export([dirty_read_all/1, dirty_foreach_key/2, dirty_dump_log/1]).
55
55
-export([append_file/2, ensure_parent_dirs_exist/1]).
56
56
-export([format_stderr/2]).
57
57
-export([start_applications/1, stop_applications/1]).
58
 
-export([unfold/2, ceil/1]).
 
58
-export([unfold/2, ceil/1, queue_fold/3]).
 
59
-export([pid_to_string/1, string_to_pid/1]).
 
60
-export([version_compare/2, version_compare/3]).
59
61
 
60
62
-import(mnesia).
61
63
-import(lists).
97
99
-spec(enable_cover/1 :: (string()) -> ok_or_error()).
98
100
-spec(report_cover/1 :: (string()) -> 'ok').
99
101
-spec(throw_on_error/2 ::
100
 
      (atom(), thunk({error, any()} | {ok, A} | A)) -> A). 
 
102
      (atom(), thunk({error, any()} | {ok, A} | A)) -> A).
101
103
-spec(with_exit_handler/2 :: (thunk(A), thunk(A)) -> A).
102
104
-spec(filter_exit_map/2 :: (fun ((A) -> B), [A]) -> [B]).
103
105
-spec(with_user/2 :: (username(), thunk(A)) -> A).
105
107
-spec(with_user_and_vhost/3 :: (username(), vhost(), thunk(A)) -> A).
106
108
-spec(execute_mnesia_transaction/1 :: (thunk(A)) -> A).
107
109
-spec(ensure_ok/2 :: (ok_or_error(), atom()) -> 'ok').
108
 
-spec(localnode/1 :: (atom()) -> erlang_node()).
109
 
-spec(nodehost/1 :: (erlang_node()) -> string()).
 
110
-spec(makenode/1 :: ({string(), string()} | string()) -> erlang_node()).
 
111
-spec(nodeparts/1 :: (erlang_node() | string()) -> {string(), string()}).
110
112
-spec(cookie_hash/0 :: () -> string()).
111
113
-spec(tcp_name/3 :: (atom(), ip_address(), ip_port()) -> atom()).
112
114
-spec(intersperse/2 :: (A, [A]) -> [A]).
126
128
-spec(stop_applications/1 :: ([atom()]) -> 'ok').
127
129
-spec(unfold/2  :: (fun ((A) -> ({'true', B, A} | 'false')), A) -> {[B], A}).
128
130
-spec(ceil/1 :: (number()) -> number()).
 
131
-spec(queue_fold/3 :: (fun ((any(), B) -> B), B, queue()) -> B).
 
132
-spec(pid_to_string/1 :: (pid()) -> string()).
 
133
-spec(string_to_pid/1 :: (string()) -> pid()).
129
134
 
130
135
-endif.
131
136
 
308
313
ensure_ok(ok, _) -> ok;
309
314
ensure_ok({error, Reason}, ErrorTag) -> throw({error, {ErrorTag, Reason}}).
310
315
 
311
 
localnode(Name) ->
312
 
    list_to_atom(lists:append([atom_to_list(Name), "@", nodehost(node())])).
 
316
makenode({Prefix, Suffix}) ->
 
317
    list_to_atom(lists:append([Prefix, "@", Suffix]));
 
318
makenode(NodeStr) ->
 
319
    makenode(nodeparts(NodeStr)).
313
320
 
314
 
nodehost(Node) ->
315
 
    %% This is horrible, but there doesn't seem to be a way to split a
316
 
    %% nodename into its constituent parts.
317
 
    tl(lists:dropwhile(fun (E) -> E =/= $@ end, atom_to_list(Node))).
 
321
nodeparts(Node) when is_atom(Node) ->
 
322
    nodeparts(atom_to_list(Node));
 
323
nodeparts(NodeStr) ->
 
324
    case lists:splitwith(fun (E) -> E =/= $@ end, NodeStr) of
 
325
        {Prefix, []}     -> {_, Suffix} = nodeparts(node()),
 
326
                            {Prefix, Suffix};
 
327
        {Prefix, Suffix} -> {Prefix, tl(Suffix)}
 
328
    end.
318
329
 
319
330
cookie_hash() ->
320
 
    ssl_base64:encode(erlang:md5(atom_to_list(erlang:get_cookie()))).
 
331
    base64:encode_to_string(erlang:md5(atom_to_list(erlang:get_cookie()))).
321
332
 
322
333
tcp_name(Prefix, IPAddress, Port)
323
334
  when is_atom(Prefix) andalso is_number(Port) ->
333
344
%% This is a modified version of Luke Gorrie's pmap -
334
345
%% http://lukego.livejournal.com/6753.html - that doesn't care about
335
346
%% the order in which results are received.
 
347
%%
 
348
%% WARNING: This is is deliberately lightweight rather than robust -- if F
 
349
%% throws, upmap will hang forever, so make sure F doesn't throw!
336
350
upmap(F, L) ->
337
351
    Parent = self(),
338
352
    Ref = make_ref(),
421
435
ensure_parent_dirs_exist(Filename) ->
422
436
    case filelib:ensure_dir(Filename) of
423
437
        ok              -> ok;
424
 
        {error, Reason} -> 
 
438
        {error, Reason} ->
425
439
            throw({error, {cannot_create_parent_dirs, Filename, Reason}})
426
440
    end.
427
441
 
479
493
 
480
494
ceil(N) ->
481
495
    T = trunc(N),
482
 
    case N - T of
483
 
        0 -> N;
484
 
        _ -> 1 + T
 
496
    case N == T of
 
497
        true  -> T;
 
498
        false -> 1 + T
 
499
    end.
 
500
 
 
501
queue_fold(Fun, Init, Q) ->
 
502
    case queue:out(Q) of
 
503
        {empty, _Q}      -> Init;
 
504
        {{value, V}, Q1} -> queue_fold(Fun, Fun(V, Init), Q1)
 
505
    end.
 
506
 
 
507
%% This provides a string representation of a pid that is the same
 
508
%% regardless of what node we are running on. The representation also
 
509
%% permits easy identification of the pid's node.
 
510
pid_to_string(Pid) when is_pid(Pid) ->
 
511
    %% see http://erlang.org/doc/apps/erts/erl_ext_dist.html (8.10 and
 
512
    %% 8.7)
 
513
    <<131,103,100,NodeLen:16,NodeBin:NodeLen/binary,Id:32,Ser:32,_Cre:8>>
 
514
        = term_to_binary(Pid),
 
515
    Node = binary_to_term(<<131,100,NodeLen:16,NodeBin:NodeLen/binary>>),
 
516
    lists:flatten(io_lib:format("<~w.~B.~B>", [Node, Id, Ser])).
 
517
 
 
518
%% inverse of above
 
519
string_to_pid(Str) ->
 
520
    ErrorFun = fun () -> throw({error, {invalid_pid_syntax, Str}}) end,
 
521
    %% TODO: simplify this code by using the 're' module, once we drop
 
522
    %% support for R11
 
523
    %%
 
524
    %% 1) sanity check
 
525
    %% The \ before the trailing $ is only there to keep emacs
 
526
    %% font-lock from getting confused.
 
527
    case regexp:first_match(Str, "^<.*\\.[0-9]+\\.[0-9]+>\$") of
 
528
        {match, _, _} ->
 
529
            %% 2) strip <>
 
530
            Str1 = string:substr(Str, 2, string:len(Str) - 2),
 
531
            %% 3) extract three constituent parts, taking care to
 
532
            %% handle dots in the node part (hence the reverse and concat)
 
533
            [SerStr, IdStr | Rest] = lists:reverse(string:tokens(Str1, ".")),
 
534
            NodeStr = lists:concat(lists:reverse(Rest)),
 
535
            %% 4) construct a triple term from the three parts
 
536
            TripleStr = lists:flatten(io_lib:format("{~s,~s,~s}.",
 
537
                                                    [NodeStr, IdStr, SerStr])),
 
538
            %% 5) parse the triple
 
539
            Tokens = case erl_scan:string(TripleStr) of
 
540
                         {ok, Tokens1, _} -> Tokens1;
 
541
                         {error, _, _}    -> ErrorFun()
 
542
                     end,
 
543
            Term = case erl_parse:parse_term(Tokens) of
 
544
                       {ok, Term1} -> Term1;
 
545
                       {error, _}  -> ErrorFun()
 
546
                   end,
 
547
            {Node, Id, Ser} =
 
548
                case Term of
 
549
                    {Node1, Id1, Ser1} when is_atom(Node1) andalso
 
550
                                            is_integer(Id1) andalso
 
551
                                            is_integer(Ser1) ->
 
552
                        Term;
 
553
                    _ ->
 
554
                        ErrorFun()
 
555
                end,
 
556
            %% 6) turn the triple into a pid - see pid_to_string
 
557
            <<131,NodeEnc/binary>> = term_to_binary(Node),
 
558
            binary_to_term(<<131,103,NodeEnc/binary,Id:32,Ser:32,0:8>>);
 
559
        nomatch ->
 
560
            ErrorFun();
 
561
        Error ->
 
562
            %% invalid regexp - shouldn't happen
 
563
            throw(Error)
 
564
    end.
 
565
 
 
566
version_compare(A, B, lte) ->
 
567
    case version_compare(A, B) of
 
568
        eq -> true;
 
569
        lt -> true;
 
570
        gt -> false
 
571
    end;
 
572
version_compare(A, B, gte) ->
 
573
    case version_compare(A, B) of
 
574
        eq -> true;
 
575
        gt -> true;
 
576
        lt -> false
 
577
    end;
 
578
version_compare(A, B, Result) ->
 
579
    Result =:= version_compare(A, B).
 
580
 
 
581
version_compare([], []) ->
 
582
    eq;
 
583
version_compare([], _ ) ->
 
584
    lt; %% 2.3 < 2.3.1
 
585
version_compare(_ , []) ->
 
586
    gt; %% 2.3.1 > 2.3
 
587
version_compare(A,  B) ->
 
588
    {AStr, ATl} = lists:splitwith(fun (X) -> X =/= $. end, A),
 
589
    {BStr, BTl} = lists:splitwith(fun (X) -> X =/= $. end, B),
 
590
    ANum = list_to_integer(AStr),
 
591
    BNum = list_to_integer(BStr),
 
592
    if ANum =:= BNum -> ATl1 = lists:dropwhile(fun (X) -> X =:= $. end, ATl),
 
593
                        BTl1 = lists:dropwhile(fun (X) -> X =:= $. end, BTl),
 
594
                        version_compare(ATl1, BTl1);
 
595
       ANum < BNum   -> lt;
 
596
       ANum > BNum   -> gt
485
597
    end.