cean.erl

%%% ====================================================================
%%% This software is copyright (c) 2006-2007, Process-one.
%%%
%%% $Id$
%%%
%%% @copyright 2006-2007 Process-one
%%% @author Christophe Romain <[email protected]>
%%%   [http://www.process-one.net/]
%%% @author Bengt Kleberg <[email protected]>
%%% @version {@vsn}, {@date} {@time}
%%% @end
%%% ====================================================================

%%% @doc The module <strong>{@module}</strong> is the command line interface
%%% to CEAN site. It handles erlang packages installation/upgrade/remove.
%%%
%%% @reference See <a href="http://cean.process-one.net">CEAN Web Site</a>
%%% for detailed CEAN description.

-module(cean).
-author("Christophe Romain <[email protected]>").
-author("Bengt Kleberg <[email protected]>").
-vsn("1.3").

%% Info service
-export([version/0]).
%% Packaging service
-export([
    available/0,
    available/1,
    depends/1,
    display/1,
    help/0,
    help/1,
    installed/0,
    installed_dependent_upon/1,
    is_installed/1,
    search/1,
    install/1,
    install/2,
    new/0,
    newest_available/1,
    newest_installed/1,
    proxy_user/2,
    purge/0,
    quit/0,
    remote/2,
    uninstall/1,
    upgrade/0,
    upgrade/1,
    upgrade/2,
    cluster/1,
    cluster/2,
    set_server/1,
    get_server/0
]).

-define(DEFAULT_SERVER, "http://cean.process-one.net").
-define(CONN_TIMEOUT, 60000).
-define( PROXY_HOST, "HTTP_PROXY" ).
-define( PROXY_HOST_SEPARATOR, ":" ).
-define( PROXY_USER, "CEAN_PROXY_USER" ).
-define( PROXY_USER_SEPARATOR, [4] ).

%% -- public functions

available() ->
    case getlist() of
    {ok, L} ->
        %% remove version, get rid of duplicates (the same package with different versions)
        lists:usort(lists:map( fun(LibDir) -> no_vsn(LibDir) end, L ));
    {error, R} ->
        io:fwrite("error: ~p~n",[R]),
        []
    end.

%% @spec available(Package::item()) -> list()
% input
%    Package : the base name (no version) of a package
% returns
%    a list of all available versions of the package
% exceptions
%
available( Package ) when is_atom(Package) -> available( erlang:atom_to_list(Package) );
available( Package ) ->
    case getlist() of
    {ok, L} ->
        Fun = fun(Lib) ->
            case no_vsn( Lib ) of
            Package -> true;
            _Else -> false
            end
        end,
        lists:filter( Fun, L );
    {error, R} ->
        io:fwrite("error: ~p~n",[R]),
        []
    end.


%% @spec display(Item::item()) -> atom()
% input
%    Item is either an atom (one of available, installed, new) or a list of strings.
%    If Item is an atom the function with the same name as the atom is run and
%    the result (a list of strings) is displayed.
%    this function is a helper for when the result of a function is a too long list
% returns
%
% execption
%
display( available ) -> display( available() );
display( installed ) -> display( installed() );
display( new ) -> display( new() );
display( List ) when is_list(List) ->
    lists:foreach( fun(Item) -> io:fwrite( "~s~n", [Item] ) end, List ),
    io:fwrite( "~n" ).

%% @spec depends(Package::item()) -> list()
% input
%    Package can be either an atom or a string.
%    If it is an atom it will be turned into a string
% returns
%    A list of packages that package depends upon.
% execption
%
depends( Package ) when is_atom(Package) -> depends( erlang:atom_to_list(Package) );
depends( Package ) ->
    case getdeps( Package ) of
    {ok, Depends} -> Depends; 
    {error, Error} ->
        io:fwrite( "failed to get dependencies: ~w~n", [Error] ),
        []
    end.

%% @spec help() -> atom()
% input
%
% returns
%
% execption
%
% description
%    disply help text
%
help() ->
    Exported = lists:usort( [Function || {Function, _Arity} <- ?MODULE:module_info(exports)] ),
    io:fwrite( "The functions are: ~p~n", [Exported] ),
    io:fwrite( "Do help(<function>) for more help on that function.~n" ).

%% @spec help(Function::atom()) -> atom()
% input
%    Function : a function name
%
% returns
%
% execption
%
% description
%    disply help text about Function
%
help( available ) ->
    io:fwrite( "~w:available(). => [Package1, Package2, ...]~n", [?MODULE] ),
    io:fwrite( "Returns a list of available packages~n" ),
    io:fwrite( "~w:available(Package). => [Package-vsn1, Package-vsn2, ...]~n", [?MODULE] ),
    io:fwrite( "Returns a list of available versions of package~n" );
help( depends ) ->
    io:fwrite( "~w:depends( Package ). => [Package1, Package2, ...]~n", [?MODULE] ),
    io:fwrite( "Returns a list of all packages that Package depends upon.~n" );
help( display ) ->
    io:fwrite( "~w:display( List_of_strings ). => ok~n", [?MODULE] ),
    io:fwrite( "Will display the result (a list of strings) of a function. ~n" ),
    io:fwrite( "~w:display( Function ). => ok~n", [?MODULE] ),
    io:fwrite( "Will run a function (without arguments) and the result (a list of strings) is displayed. ~n" ),
    io:fwrite( "Display is a helper for when the result of a function is a too long list~n" );
help( help ) ->
    io:fwrite( "~w:help(). => ok~n", [?MODULE] ),
    io:fwrite( "Will display a help text about available functions~n" ),
    io:fwrite( "~w:help( Function ). => ok~n", [?MODULE] ),
    io:fwrite( "Will display a help text about a function~n" );
help( install ) ->
    io:fwrite( "~w:install( Package ). => ok~n", [?MODULE] ),
    io:fwrite( "Will install a package for atmost 60 seconds.~n" ),
    io:fwrite( "~w:install( Package, Timeout ). => ok~n", [?MODULE] ),
    io:fwrite( "Will install a package for atmost Timeout minutes.~n" );
help( installed_dependent_upon ) ->
    io:fwrite( "~w:installed_dependent_upon( Package ). => [Package1, Package2, ...]~n", [?MODULE] ),
    io:fwrite( "Will return a list of installed packages that depend upon Package.~n" );
help( is_installed ) ->
    io:fwrite( "~w:is_installed( Package ). => true|false~n", [?MODULE] ),
    io:fwrite( "Will return true if a package is installed.~n" );
help( module_info ) ->
    io:fwrite( "~w:module_info( ). => list()~n", [?MODULE] ),
    io:fwrite( "Will return a list of module info that is automagically generated by erlang.~n" );
help( new ) ->
    io:fwrite( "~w:new( ). => [Package1, Package2, ...]~n", [?MODULE] ),
    io:fwrite( "Will return a list of packages that are new at CEAN archive.~n" );
help( newest_available ) ->
    io:fwrite( "~w:newest_available( Package ). => Package-vsn~n", [?MODULE] ),
    io:fwrite( "Will return the name of newest package with version at CEAN server.~n" );
help( newest_installed ) ->
    io:fwrite( "~w:newest_installed( Package ). => Package-vsn~n", [?MODULE] ),
    io:fwrite( "Will return the newest package version installed.~n" );
help( proxy_user ) ->
    io:fwrite( "~w:proxy_user( User, Password ). => ok~n", [?MODULE] ),
    io:fwrite( "Will make requests towards the cean archive use a firewall proxy user/password. Both arguments should be strings, not atoms.~n" );
help( purge ) ->
    io:fwrite( "~w:purge( ). => ok~n", [?MODULE] ),
    io:fwrite( "Will empty the uninstall directory.~n" );
help( quit ) ->
    io:fwrite( "~w:quit( ). => ok~n", [?MODULE] ),
    io:fwrite( "Will quit CEAN. Same as q().~n" );
help( remote ) -> io:fwrite( "not implemented.~n" );
help( search ) ->
    io:fwrite( "~w:search( Package ). => ok~n", [?MODULE] ),
    io:fwrite( "Will display a (short) description of package.~n" );
help( uninstall ) ->
    io:fwrite( "~w:uninstall( Package ). => ok~n", [?MODULE] ),
    io:fwrite( "Will uninstall a package by moving it to a uninstall directory.~n" );
help( upgrade ) ->
    io:fwrite( "~w:upgrade( ). => ok~n", [?MODULE] ),
    io:fwrite( "Will upgrade all installed packages for atmost 60 seconds.~n" ),
    io:fwrite( "~w:upgrade( Timeout ). => ok~n", [?MODULE] ),
    io:fwrite( "Will upgrade all installed packages for atmost Timeout minutes.~n" ),
    io:fwrite( "~w:upgrade( Package ). => ok~n", [?MODULE] ),
    io:fwrite( "Will _only_ upgrade package, not dependencies.~n" ),
    io:fwrite( "Will upgrade package for atmost 60 seconds.~n" ),
    io:fwrite( "~w:upgrade( Package, Timeout ). => ok~n", [?MODULE] ),
    io:fwrite( "Will _only_ upgrade package, not dependencies.~n" ),
    io:fwrite( "Will upgrade package for atmost Timeout minutes.~n" );
help( version ) ->
    io:fwrite( "~w:version( ). => Version~n", [?MODULE] ),
    io:fwrite( "Will return a version string for ~w~n", [?MODULE] );
help( Function ) ->
    case lists:member( Function, lists:usort([Exported || {Exported, _Arity} <- ?MODULE:module_info(exports)]) ) of
    true -> io:fwrite( "I have forgotten to write help for ~w~n", [Function] );
    false -> io:fwrite( "There is no ~w~n", [Function] )
    end.


install(Package) when is_atom(Package) -> install( erlang:atom_to_list(Package) );
install(Package) -> install( Package, 1 ).

install( Package, Timeout ) when is_atom(Package) -> install( erlang:atom_to_list(Package), Timeout );
install( Package, Timeout ) -> install( Package , true, false, Timeout).

installed() ->
    Contents = lib_dir_visible_contents(),
    lists:sort( lists:map(fun(LibDir) -> no_vsn(LibDir) end, Contents)).


installed_dependent_upon(Package) when is_atom(Package) -> installed_dependent_upon(atom_to_list(Package));
installed_dependent_upon(Package) ->
    Fun = fun(Installed) ->
        case getdeps(Installed) of
        {ok, Deps} -> lists:member( Package, [no_vsn(Item) || Item <- Deps] );
        {error, Reason} ->
            io:fwrite( "failed to find dependencies for ~s: ~p~n", [Installed, Reason] ),
            false
        end
    end,
    lists:filter( Fun, installed() ).


is_installed(Package) when is_atom(Package) -> is_installed(atom_to_list(Package));
is_installed(Package) -> lists:member(Package,installed()).


new() ->
    Last = case getlist() of
        {ok, L1} -> lists:sort( L1 );
        {error, _} -> []
        end,
    Actual = lib_dir_visible_contents(),
    lists:foldl(fun(Lib,New) ->
            case lists:member(Lib,Last) of
            true -> New;
            false -> [no_vsn(Lib)|New]
            end
        end,
        [],
        Actual).

newest_available( Package ) -> newest_available_from_list( available(Package) ).


newest_installed( Package ) when is_atom(Package) -> newest_installed( erlang:atom_to_list(Package) );
newest_installed( Package ) -> newest_available_from_list( installed_package_with_vsn(Package) ).

remote( _Cmd, _Args) -> %% TODO
    % connect ssh
    % check machine platform
    % install required bootstrap or lib
    ok.

proxy_user( User, Password ) ->
    os:putenv( ?PROXY_USER,
        lists:append([User, ?PROXY_USER_SEPARATOR, Password]) ).

purge() ->
    Uninstall_dir = uninstall_dir(),
    lists:foreach( fun(Package) -> remove( Uninstall_dir, Package ) end,
        filelib:wildcard("*", Uninstall_dir) ).

quit() -> init:stop().

search(Word) when is_atom(Word) ->
    search(atom_to_list(Word));
search(Words) ->
    UW = lists:map(fun($ )->$+;(C)->C end,Words),
    Query = "/packages/index.yaws?action=filter&seek="++UW,
    Url = server_append( Query ),
    packages_from_html(Url).

uninstall(Package) when is_atom(Package) ->
    uninstall(atom_to_list(Package));
uninstall("stdlib") -> {error,can_not_remove};
uninstall("kernel") -> {error,can_not_remove};
uninstall("cean") -> {error,can_not_remove};
uninstall(Package) ->
    P = erlang:list_to_atom( Package ),
    catch P:stop(),    % just in case
    case installed_dependent_upon( Package ) of
    [] -> uninstall_many( installed_package_with_vsn(Package) );
    Dependent -> io:fwrite( "can not uninstall ~s. ~p are dependent upon it.~n", [Package, Dependent] )
    end.

upgrade() -> upgrade( 1 ).

upgrade( Timeout ) when is_integer(Timeout) ->
    lists:foreach(fun(Lib) -> upgrade( Lib, Timeout ) end, installed());
upgrade( Package ) when is_atom(Package) -> upgrade( erlang:atom_to_list(Package) );
upgrade( Package ) -> upgrade( Package, 1 ).

upgrade( Package, Timeout ) when is_atom(Package) -> upgrade( erlang:atom_to_list(Package), Timeout );
upgrade( Package, Timeout ) ->
    case newest_available( Package ) of
    [] ->
        io:fwrite( "no package available~n" ),
        ok;
    Newer ->
        case is_newer( Newer, newest_installed(Package) ) of
        true ->
            install( Package, false, true, Timeout ),
            Installed = installed_package_with_vsn( Package ),
            Old = lists:nthtail(1,lists:reverse(Installed)),
            uninstall_many( Old ),
            ok;
        false ->
            io:fwrite( "~s: no newer package available~n", [Package] ),
            ok
        end
    end.

version() ->
    case file:read_file(filename:join([code:root_dir(),"VERSION"])) of
    {ok,Data} -> hd(string:tokens(binary_to_list(Data),"\n\r"));
    {error,_} -> "CEAN Erlang/OTP"
    end.

%% -- internal functions
baseurl() ->
    baseurl([]).
baseurl(Pre) ->
    Url = case string:tokens(version()," ") of
    ["CEAN","Erlang/OTP",Otp,_Erts,Arch,Distrib] ->
        lists:append([Pre,"/",no_vsn(Otp),"/",Distrib,"/",Arch]);
    _ ->
        "/error/badversion"
    end,
    server_append( Url ).

puburl() ->
    %Url = case string:tokens(version()," ") of
    %    ["CEAN","Erlang/OTP",Otp,_Erts,_Arch,_Distrib] ->
    %        lists:append(["/",no_vsn(Otp),"/desc"]);
    %    _ ->
    %        "/error/depends"
    %    end,
    server_append( "/packages" ).

ebin_dir( Package ) -> filename:join([code:lib_dir(), Package, "ebin"]).

getarchive(Archive, Timeout) ->
    TarUrl = lists:append([baseurl(),"/",Archive,".tar.gz"]),
    case geturl( TarUrl, [{save_response_to_file,true}], Timeout ) of
    {ok,_,_,{file,undefined}} -> {error, {file,undefined}};
    {ok,_, Header, {file, Archive_contents}} -> {Header, Archive_contents};
    {error, Reason} -> {error, Reason}
    end.

getdeps(Archive) ->
    Url = lists:append([puburl(),"/",Archive,".pub"]),
    case geturl( Url ) of
    {ok,_,_, [$<|_]} -> 
        {error, no_pub_file};
    {ok,_,_, Pub} -> 
        % BUG, this does not handle depends written on several lines
        Deps = lists:foldl(fun(String, Acc) ->
            case hd(string:tokens(String, ",")) of
            "{depends" ->
                case erl_scan:string(String) of
                {ok, Tokens, _} ->
                    lists:foldl(fun(Tuple, SubAcc) ->
                        case Tuple of
                        {atom,1,depends} -> SubAcc;
                        {atom,1,A} -> [atom_to_list(A)|SubAcc];
                        {string,1,S} -> [S|SubAcc];
                        _ -> SubAcc
                        end
                    end, Acc, Tokens);
                _ -> 
                    Acc
                end;
            _ -> 
                Acc
            end
        end, [], string:tokens( Pub, "\n" )),
        {ok, Deps};
    {error, Reason} -> 
        {error, Reason}
    end.

getlist() ->
    Url = baseurl()++".vsnlst",
    case geturl( Url ) of
    {ok,_,_, List} -> {ok, string:tokens( List, "\n" )};
    {error, Reason} -> {error, Reason}
    end.


geturl(Url) ->
    geturl( Url, [], 1 ).
geturl(Url, UsrOpts, Timeout) ->
    ibrowse:start(),
    Opts = lists:append(proxyopts(),UsrOpts),
    Answer = ibrowse:send_req( Url, [], get, [], Opts, (Timeout * ?CONN_TIMEOUT) ),
    %ibrowse:stop(), replace {stop, shutting_down, ok, State} by {stop, normal, ok, State}
    Answer.

%% install dependencies, too
install( Package, true, Force, Timeout ) ->
    case getdeps(Package) of
    {ok, Deps} ->
        lists:foreach(fun(Dep) -> install( no_vsn(Dep), false, false, Timeout) end, Deps),
        case lists:all( fun(Dep) -> is_installed(no_vsn(Dep)) end, Deps ) of
        true -> install( Package, false, Force, Timeout );
        false -> io:fwrite( "~s was not installed. failed to install all dependencies.~n",[Package])
        end;
    {error, Reason} -> io:fwrite( "~s was not installed. failed to find dependencies: ~p~n",[Package, Reason])
    end;
%% install package
install( Package, false, Force, Timeout ) ->
    case Force orelse not is_installed(Package) of
    true ->
        case getarchive( Package, Timeout ) of
        {error, req_timedout} ->
            io:fwrite("error: ~s not downloaded: request timed out. try increasing timeout.~n",[Package]),
            error;
        {error, Reason} ->
            io:fwrite("error: ~s not downloaded: ~p~n",[Package , Reason]),
            error;
        {Header, Archive} -> 
            case lists:keysearch("Content-Type",1,Header) of
            {value,{"Content-Type","application/x-gzip"}} ->
                io:format("+ ~s md5=~p~n",[Package,uncompress(Archive)]),
                NewLib = lists:last( lists:sort(installed_package_with_vsn( Package )) ),
                EbinPath = ebin_dir( NewLib ),
                code:add_path(EbinPath),
                %% obsolete install_backwards_compatible( NewLib ),
                install_include_symlink( NewLib ),
                ok;
            _Else ->
                io:format("error: ~s not found in download~n",[Package]),
                error
            end
        end;
    false ->
        ok
    end.

% following code allows backward compatibility of module
% so, cean packages can be installed in non-cean systems
install_backwards_compatible( New_lib ) ->
    case code:priv_dir( no_vsn(New_lib) ) of
    {error,_Reason} -> ok;
    Old_priv_dir ->
        New_priv_dir = priv_dir( New_lib ),
        Fun = fun(Dir) ->
            Source = filename:join( [Old_priv_dir, Dir] ),
            Destination = filename:join( [New_priv_dir, Dir] ),
            %% make symlink. if that fails, copy (windows case)
            case file:make_symlink( Source--(New_priv_dir++"/"), Destination ) of
            ok -> ok;
            _ ->
                % this does not work, needs to be recursive copy
                file:make_dir( Destination ),
                lists:foreach( fun(File) -> 
                    FileName = lists:last(string:tokens(File,"/\\")), % comment for vim color "
                    file:copy(File, Destination) 
                    end, filelib:wildcard(filename:join([Source,"*"])) )
            end
        end,
        lists:foreach( Fun, ["bin", "lib"])
    end.

% following code allow easy include files storing
install_include_symlink( New_lib ) ->
    Source = filename:join([code:lib_dir(), New_lib, "include"]),
    case filelib:is_dir(Source) of
    true ->
        case os:type() of
        {unix, _} ->
            % best here is to use a shell command to perform relative symlink
            Cmd = io_lib:format("cd ~s/include; rm ~s; ln -s ../lib/~s/include ~s", 
                [code:root_dir(), no_vsn( New_lib ), New_lib, no_vsn( New_lib )]),
            os:cmd(Cmd);
        _ ->
            Destination = filename:join([code:root_dir(), "include", no_vsn( New_lib )]),
            file:make_dir(Destination),
            lists:foreach( fun(File) -> 
                FileName = lists:last(string:tokens(File,"/\\")), % comment for vim color "
                file:copy(File, filename:join([Destination,FileName]))
                end, filelib:wildcard(filename:join([Source,"*"])) )
        end;
    false ->
        {error, no_include_dir}
    end.

installed_package_with_vsn( Package ) -> filelib:wildcard( Package++"-*", code:lib_dir() ).

is_newer( Package_that_might_be_newer, Package ) ->
    P_newer = [erlang:list_to_integer(N) || N <- string:tokens( vsn( Package_that_might_be_newer ), "." )],
    P = [erlang:list_to_integer(N) || N <- string:tokens( vsn( Package ), "." )],
    P_newer > P.

%% @spec lib_dir_visible_contents() -> list()
% input
%
% returns
%    list of the visible contetns of lib dir.
%    unix has hidden contents indicated by a "." first in the name.
%
% execption
%    will exit if code:lib_dir/0 is not a directory
%
lib_dir_visible_contents() ->
    {ok, Contents} = file:list_dir( code:lib_dir() ),
    [Visible || [First_char|_T] = Visible <- Contents, First_char /= $.].

newest_available_from_list( Packages ) ->
    case lists:sort( fun is_newer/2, Packages ) of
    [Newest|_T] -> Newest;
    _Error -> []
    end.

no_vsn(Name) -> lists:takewhile(fun($-)->false;(_)-> true end,Name).

packages_from_html(Url) ->
    case geturl(Url) of
    {ok,_,_,Html} -> packages_from_html(Html,[]);
    _ -> []
    end.
packages_from_html([],Packages) ->
    Packages;
packages_from_html(Html,Packages) ->
    case string:str(Html,"class=\"package\"") of
    0 -> Packages;
    Start -> 
        Sub = string:sub_string(Html,Start),
        T1 = string:sub_string(Sub,string:chr(Sub,$>)+1),
        PName = string:sub_string(T1,1,string:chr(T1,$<)-1),
        T2 = string:sub_string(T1,string:str(T1,"<i>")+3),
        Descr = string:sub_string(T2,1,string:str(T2,"</i>")-1),
        packages_from_html(T2,[{PName,Descr}|Packages])
    end.

priv_dir( Package ) -> filename:join([code:lib_dir(), Package, "priv"]).

proxyopts() ->
    Proxy = case proxyopts( ?PROXY_HOST, ?PROXY_HOST_SEPARATOR ) of
        [] -> [];
        [Host, Port_string] ->
            Port = erlang:list_to_integer(Port_string),
            [{proxy_host,Host},{proxy_port,Port}]
        end,
    case proxyopts( ?PROXY_USER, ?PROXY_USER_SEPARATOR ) of
    [] -> Proxy;
    [User, Password] ->
        [{proxy_user,User}, {proxy_password,Password}|Proxy]
    end.

proxyopts( Environment_variable, Separator ) ->
    case os:getenv( Environment_variable ) of
    false -> [];
    "" -> [];
    Value -> string:tokens( Value, Separator )
    end.

remove(Path, File) ->
    Desc = filename:join([Path,File]),
    case filelib:is_dir(Desc) of
    true ->
        case file:list_dir(Desc) of
        {ok,Sub} -> lists:foreach(fun(S) -> remove(Desc,S) end,Sub);
        {error,Reason} -> io:format("error: ~p~n",[Reason])
        end,
        file:del_dir(Desc);
    false ->
        file:delete(Desc)
    end.

%% @spec server_append(Url::list()) -> list()
% input
%    Url : any string (here used with url)
% returns
%    cean server (as string) appended with url.
%
% execption
%
server_append( Url ) ->
    case get_server() of
    false -> lists:append( ?DEFAULT_SERVER, Url );
    Server -> lists:append( Server, Url )
    end.

set_server( BaseUrl ) ->
    os:putenv( "CEAN_SERVER", BaseUrl ).
get_server() ->
    os:getenv( "CEAN_SERVER" ).

uncompress(Archive) ->
    Sum = case file:read_file(Archive) of
    {ok,Tgz} -> 
        Tar = zlib:gunzip(Tgz),
        erl_tar:extract({binary,Tar},[{cwd,code:lib_dir()}]),
        erlang:md5(Tgz);
    {error,_} -> 0
    end,
    file:delete(Archive),
    Sum.

%% @spec uninstall_many(Packages::list()) -> atom()
% input
%    Packages : list of Application directories
% returns
%
% execption
%    will exit if move of package to Uninstall_dir fails
uninstall_many( Packages ) ->
    Lib_dir = code:lib_dir(),
    Uninstall_dir = uninstall_dir(),
    lists:foreach( fun(Package_dir) ->
            catch remove( Uninstall_dir, Package_dir ), % just in case
            case file:rename( filename:join([Lib_dir, Package_dir]), filename:join([Uninstall_dir, Package_dir]) ) of
            ok ->
                io:fwrite( "- ~s~n",[Package_dir] ),
                code:del_path( ebin_dir(Package_dir) );
            {error,Reason} ->
                io:fwrite( "can not remove ~s: ~s~n",[Package_dir, Reason] )
            end
        end,
        Packages ).


%% @spec uninstall_dir() -> list()
% input
%
% returns
%    directory for applications that are uninstalled
%
% execption
%
uninstall_dir() ->
    Uninstall_dir = filename:join( [code:root_dir(),"uninstalled"] ),
    filelib:ensure_dir( filename:join([Uninstall_dir, "afile"]) ),
    Uninstall_dir.

vsn(Name) ->
    case lists:dropwhile(fun($-)->false;(_)->true end,Name) of
    [_Sep|Vsn] -> Vsn;
    _ -> "0"
    end.


%% cluster handling
% ssh is used to deploy cean_base and current start.sh
% then cean node is remote started and cean master can apply rpc on all nodes.
% automatic node seek at cean cluster start
% when cluster started, all functions called locally and remotely on available nodes.
cluster(nodes) ->
    cean_cluster:cean_nodes(all);
cluster(start) ->
    not_implemented;
cluster(stop) ->
    cean_cluster:stop_nodes(remote);
cluster(status) ->
    cean_cluster:status(remote);
cluster(sync) ->
    cean_cluster:sync(remote);
cluster(help) ->
    "cluster(nodes) -> [Node,...] - return a list of cean nodes in this cluster.\n"
        "cluster(status) -> [{Node, SyncStatus},...] - check if the cean packages are synchronised on the nodes in the cluster, report missing or additional packages if they differ.\n"
        "cluster(sync) -> ".

cluster(status, Node) ->
    cean_cluster:status(Node);
cluster(start, Node) ->
    cean_cluster:start_nodes([Node]);
cluster(stop, Node) ->
    cean_cluster:stop_nodes([Node]);
cluster(install, Package) ->
    cean_cluster:install(Package, all);
cluster(uninstall, Package) ->
    cean_cluster:uninstall(Package, all);
cluster(sync, Node) ->
    cean_cluster:sync(Node).

cean_cluster.erl

%%% ====================================================================
%%% This software is copyright (c) 2006-2008, Process-one.
%%%
%%% $Id$
%%%
%%% @copyright 2006-2007 Process-one
%%% @author Geoff Cant <[email protected]>
%%%   [http://www.process-one.net/]
%%% @author Christophe Romain <[email protected]>,
%%% @version {@vsn}, {@date} {@time}
%%% @end
%%% ====================================================================

%%% @doc The module <strong>{@module}</strong> manages operations on a
%%% cluster of erlang nodes running CEAN. It handles package
%%% syncronisation/installation/upgrade/removal and management of
%%% cluster nodes.
%%%
%%% @reference See <a href="http://cean.process-one.net">CEAN Web Site</a>
%%% for detailed CEAN description.

-module(cean_cluster).

-export([stop_nodes/1,
         stop_node/1,
         start_nodes/1,
         start_node/1,
         install/2,
         uninstall/2,
         sync_nodes/1,
         sync_node/1,
         status/1,
         node_status/1,
         is_synchronised/0,
         is_synchronised/1]).

-export([is_cean_node/0,
         is_cean_node/1,
         cean_nodes/1,
         compare_installed/2,
         installed/1,
         node_host/1]).

-record(diff, {same=[],
               missing=[],
               extra=[]}).

%% Perform Fun(Node) -> [{Node, Result}] on a list of nodes.
%% TODO: run actions in parallel.
cluster_action(Action, NodeList) ->
    lists:map(fun (N) -> {N, Action(N)} end,
              cean_nodes(NodeList)).

%% Function adapter to allow calling cean module operations remotely.
%% Used with cluster_action to perform the same cean operations on
%% lists of nodes.
cean_action(Function, Arguments) ->
    fun (Node) -> rpc:call(Node, cean, Function, Arguments) end.

%% Return the package differences of this node to a list of other nodes. 
status(N) ->
    cluster_action(fun node_status/1, N).

node_status(Node) when is_atom(Node) ->
    case compare_installed(node(), Node) of
        #diff{missing=[],extra=[]} -> synchronised;
        #diff{missing=M,extra=E} ->
            [T || T = {_, List} <- [{missing, M}, {extra, E}],
                  List =/= []]
    end.

is_synchronised() ->
    is_synchronised(remote).
is_synchronised(Nodes) ->
    lists:all(fun (N) -> node_status(N) =:= synchronised end,
              cean_nodes(Nodes)).

stop_nodes(N) ->
    cluster_action(fun stop_node/1, N).

stop_node(N) when is_atom(N) ->
    slave:stop(node_host(N)).

start_nodes(N) ->
    cluster_action(fun start_node/1, N).

start_node(Node) when is_atom(Node) ->
    case slave:start(node_host(Node)) of
        {OK, N} when OK =:= ok;
                     OK =:= already_running ->
            true = rpc:call(N, cean, set_server, [ cean:get_server() ]),
            {ok, N};
        Error -> {error, {"Couldn't start slave node", Error}}
    end.

install(Package, Nodes) ->
    cluster_action(cean_action(install, [Package]), Nodes).

uninstall(Package, Nodes) ->
    cluster_action(cean_action(uninstall, [Package]), Nodes).

sync_nodes(Nodes) ->
    cluster_action(fun sync_node/1, Nodes).

sync_node(Node) when is_atom(Node) ->
    #diff{missing=Missing,
          extra=Extra} = compare_installed(node(), Node),
    Install = cean_action(install, Node),
    Uninstall = cean_action(uninstall, Node),
    [{P, Install(P)} || P <- Missing] ++ [{P, Uninstall(P)} || P <- Extra].

compare_installed(Node, NodeB) ->
    compare_packages(installed(Node),
                     installed(NodeB)).

compare_packages(PackageList, PackageListB) ->
    PackageSet = sets:from_list(PackageList),
    PackageSetB = sets:from_list(PackageListB),
    Same = sets:intersection(PackageSet, PackageSetB),
    Missing = sets:subtract(PackageSet, PackageSetB),
    Extra = sets:subtract(PackageSetB, PackageSet),
    #diff{same=sets:to_list(Same),
          missing=sets:to_list(Missing),
          extra=sets:to_list(Extra)}.
    
installed(ThisNode) when ThisNode =:= node() ->
    cean:installed();
installed(Node) ->
    rpc:call(Node, cean, installed, []).

%% This function will only be present on CEAN nodes (any node with the
%% cean module loaded - or capable of being loaded is a cean node).
is_cean_node() ->
    true.

is_cean_node(Node) ->
    case rpc:call(Node, cean_cluster, is_cean_node, []) of
        true -> true;
        {badrpc, {'EXIT', {undef, _}}} ->
            false
    end.

cean_nodes(all) ->
    [Node || Node <- [node() | nodes()], 
             is_cean_node(Node)];
cean_nodes(remote) ->
    %% nodes() only returns remote nodes.
    [Node || Node <- nodes(),
             is_cean_node(Node)];
cean_nodes(Node) when is_atom(Node) ->
    [Node];
cean_nodes(NodeList) when is_list(NodeList) ->
    NodeList.

node_host(Node) when is_atom(Node) ->
    case string:tokens(atom_to_list(Node), "@") of
        [_Name, Host] -> list_to_atom(Host);
        [Host] -> list_to_atom(Host)
    end.