EazyErl !

"Pseudo Randomly" retrieve data...

2011-10-12T12:53:00.000+02:00

When you want to crawl some websites and you want to hide yourself a little, here's a simple trick to change randomly your user-agent string.
There's a very convenient function in erlang called 'uniform' from the module 'random', you can use it by calling 'random:uniform(MaxValue)' where MaxValue is the high limit.

So if you want to generate a random value from 1 to 5 you can simple use, 'random:uniform(5)'...

Now that you know how to generate random values, here's some code that do just what's the title say:


peek_rand(List) ->
 Rand = random:uniform(length(List)),
 lists:nth(Rand, List).

This 'peek_rand/1' fun returns the random'th element from the list List.

Now we can make a simple server loop that will send back a random string to whoever call him:


loop(List) ->
 receive
  {get, Who} ->
   Rand = random:uniform(length(List)),
   Who ! {ua, lists:nth(Rand, List), Rand},
   loop(List);

  {add, Ua} ->
   loop([Ua|List]);
  
  stop ->
   dump(List),
   exit;
   
  _E -> 
   loop(List)
 end.

We have also implemented a message that let you store new strings into the main list, look at the message '{add, Ua}' to understand...

To summup here, we are able to randomly peek a string from a list, and give it back to some other process...
Wouldn't be nice if we were able to store this list of strings ?
Of course yes !

So let's look at the 'io:format/3' fun. We know that the format string can contain the '~p' that basically express in a simple form any erlang term, and more precisely a List...

 
dump(List) ->
 {ok, Fd} = file:open("ua.list", [write]),
 io:format(Fd, "~p.~n", [List]),
 file:close(Fd).

And this is a convenient way to retrieve the data written in the 'ua.list':


load() ->
 {ok, [List|_]} = file:consult("ua.list"),
 List.

erlang: Simple Debug macro

2010-07-29T14:58:00.010+02:00

When testing things I need some quick way to debug "a la" printf() style. Old habits :)

Here's is the simple debug macro I use:

-ifdef(debug).
-define(DEBUG(Format, Args),
  io:format("~s.~w: DEBUG: " ++ Format, [ ?MODULE, ?LINE | Args])).
-else.
-define(DEBUG(Format, Args), true).
-endif.

Write it down in a "debug.hrl" file, then you only need to add this line in any file header:

-include("debug.hrl").

This simple macro gives you the module name and the line number. This saves me a lot of time.

Then you need to define the "debug" atom to let your macro do what you want. The compile:file/2 handles options for this, the syntax is {d, debug}

You can also use some simple helper module to compile multiples files using simple regexp:
Here's the code:

-module(utils_compile).

-export([c/1, c/2, d/1, d/2]).

c(FilePattern) ->
 c(FilePattern, "../ebin").

c(FilePattern, OutDir) ->
 filelib:fold_files(".", FilePattern ++ ".erl$", false, 
 fun(X, _Acc) -> 
  io:format("Compiling ~p~n", [ X ]), 
  compile:file(X, [{outdir, OutDir}, report]) end, []).

d(FilePattern) ->
 d(FilePattern, "../ebin").

d(FilePattern, OutDir) ->
 filelib:fold_files(".", FilePattern ++ ".erl$", false, 
 fun(X, _Acc) -> 
  io:format("Compiling (debug) ~p~n", [ X ]), 
  compile:file(X, [{outdir, OutDir}, {d, debug}, report]) end, []).

Filtering lines efficiently

2010-02-24T09:00:00.007+01:00

Whenever you are dealing with log lines or that you're program is filtering data you always have to handle 'escaping' efficiently.

While developing a log module using a gen_event, I needed to escape simple quotes.
Sometime thoses quotes were already escaped...

I've found this regexp to handle gracefully the case:

re:replace( Bin, "(?<!\\\\)'", "\\\\'", [ global ] ).

Not so easy to read, and because of the various backslashes, this regexp needed some tests
before being fully usable.
Basically this regexp only filter simple quote when they're not already escaped...

Now that I've my filter for quotes and I need a filter for newline characters.
Everytime you find some newlines in your log files, you can be sure that many tools already in your network will not treat them efficiently, worse this may break everything after ...

So I came across this regexp:

re:replace( Bin, "[\\n\\r]+", " ", [ global ] ).

Finally having two filter functions for every line, I wanted to be able to add or remove easily any function.
You can reference functions with this notation:

fun filterquotes/1

Or a list of functions:

[ fun filterquotes/1, fun filternewlines/1 ]

With this notation and the famous 'lists:foldl', I can filter a line with many functions quite nicely:

% Data is the accumulator, but we don't change it :)
        lists:foldl( fun( Fun, Data ) ->
                         Fun(Data) 
        end, Bin, [ fun filterquotes/1, fun filternewline/1 ]).

Here's the code:

filter( Bin ) when is_atom(Bin) ->
        Bin;
filter( Bin ) when is_integer(Bin) ->
        Bin;
filter( Bin ) ->
        lists:foldl( fun( Fun, Data ) ->
                         Fun(Data) 
        end, Bin, [ fun filterquotes/1, fun filternewline/1 ]).

filterquotes(Bin) ->
        re:replace( Bin, "(?
filternewline( Bin ) ->
        re:replace( Bin, "[\\n\\r]+", " ", [ global ] ).

Reading an openssl .priv.key file and extracting the key

2010-02-23T21:08:00.001+01:00

Extracting the private key from a .priv.key file is simple.
The private key is encrypted using a AES-128 with your passphrase.

The initial vector is also stored in the file, you can extract it directly from the first line:

get_salt( <<"Salted__", Salt:8/binary, Rest/binary>> ) ->
        {Salt, Rest}.

The last part is handled by some md5() of your passphrase and the initial vector:

Key = crypto:md5([ Password, Salt ]),
        IV = crypto:md5([ Key, Password, Salt ]),
        crypto:aes_cbc_128_decrypt( Key, IV, Rest).

Now the full module:

-module(priv_key).

-compile(export_all).

priv_key_file( File, Password ) ->
        {ok, Bin} = file:read_file(File),
        {Salt, Rest} = get_salt(Bin),
        Key = crypto:md5([ Password, Salt ]),
        IV = crypto:md5([ Key, Password, Salt ]),
        crypto:aes_cbc_128_decrypt( Key, IV, Rest).
        
get_salt( <<"Salted__", Salt:8/binary, Rest/binary>> ) ->
        {Salt, Rest}.

erlang: Parsing binary data dynamically

2009-09-22T22:34:00.002+02:00

Hi,
here's a quick tip for parsing binary data which format is unknown at compile time...

Let's say that you have a binary string and that later you receive its structure. Take for
example the code below:

-module(binm).

-export([test/0, test/2]).

test() ->
        test(<<4,0,0,0,5,0,0,0,7,0,8,0,33,1>>, [ 4, 4, 2, 2]).

test(Bin, List) ->
        {Final, End} = lists:foldl( fun(Len, {Res, Rest}) ->
                case Rest of 
                        <<M:Len/binary, NewRest/binary>> ->
                                {[ M | Res ], NewRest};
                        <<_:1/binary, NewRest/binary>> ->
                                { Res, NewRest}
                end
                end, {[], Bin}, List),
        {lists:reverse(Final), End}.

Precisely, we want to slice the binary part into 4 parts described as '[4, 4, 2, 2]' where each element is the size.

test() ->
        test(<<4,0,0,0,5,0,0,0,7,0,8,0,33,1>>, [ 4, 4, 2, 2]).

Let's compile and run:

2> c(binm).    
{ok,binm}
3> binm:test().
{[<<4,0,0,0>>,<<5,0,0,0>>,<<7,0>>,<<8,0>>],<<33,1>>}
4>

Isn't this nice ? :p

erlang: testing many conditions easily with lists of funs...

2009-08-18T22:42:00.005+02:00

Sometimes you have to test many things before being able to choose the next action...

In many languages, you'll end up using a bunch of "if then else".
But in erlang, and the power of fun()s, you can efficiently write a simple function that will do all the job for you :p

Here is our purpose: call many functions with one argument.
For this example, we need to determine a file type with its filename.

Let's say that:
- the filename could be a valid 'word' temporary file,
- or a 'excel' temporary file or
- a known file type.

Firts let's define a simple fun that takes a list of fun and stop evaluating those fun as soon as a result is found:


% the simple case where the list is empty
any(_, []) -> undefined;

% the general case when the list contains funs...
any(Arg, [ {F, PrepareFun} | Funs] ) ->
        case F( PrepareFun(Arg) ) of
                undefined ->
                        any(Arg, Funs);

                _V ->
                        _V
        end.

In this code you'll notice that there are two fun()s:
- the 'F',
- the 'PrepareFun'.
The idea is that 'PrepareFun' will be called before calling 'F' to filter the argument 'Arg'.
Imagine that sometimes you need to extract the basename from the filename, or whatever else...

The code is a simple list iteration that recurse only if the result of the function call is 'undefined'.

Now that we have a valid fun that can iterate over a list of funs and stop whenever a valid result is found (or end of list), let's get back to our example, and build our 'filetype' function:


fileType(File) ->
        any( File, [ 
                        {fun word_temp/1, fun filename:basename/1}, 
                        {fun db_extension/1, fun lists:reverse/1},
                        {fun excel_temp/1, fun filename:basename/1}
                ]).

You can read this code like this:
"any of the funs from the list may determine the type of the file".
And once found, stops.

Let's describe those called functions 'db_extension/1', 'word_temp/1', 'excel_temp/1'...

First 'db_extension':
You'll notice that we test only the end of the filename, that's why the filename is
reversed before being passed to the function:


db_extension( "pmt."  ++ _ ) -> temp;
db_extension( "PMT."  ++ _ ) -> temp;
db_extension( "xcod." ++ _ ) -> doc;
db_extension( "cod."  ++ _ ) -> doc;
db_extension( "xslx." ++ _ ) -> xls;
db_extension( "slx."  ++ _ ) -> xls;
db_extension( "xtpp." ++ _ ) -> ppt;
db_extension( "tpp." ++ _ ) -> ppt;
db_extension( _ ) -> undefined.

The 'word_temp/1' need to call the basename of the file but we don't need the full path, so 'PrepareFun' is simply 'filename:basename/1' in this case:


word_temp( "~$"   ++ _) -> temp;
word_temp( "~WRD" ++ _) -> temp;
word_temp( "~WRL" ++ _) -> temp;
word_temp( _ ) -> undefined.

For 'excel_temp/1', the temp file is determined by a number written as 8 hexadecimal values. We use the re module to easily match this with the filename. In this case the 'PrepareFun' is also the 'filename:basename/1':


excel_temp( File ) ->
        ReList = [ <<"^[0-9A-Z]{8}$">> ],
        do_re(File, ReList).
        
% We are able to test many re but in the specific

% case the list contains only one element...
do_re(_, []) -> undefined;
do_re(Subject, [ Re | Rest ]) ->
        case re:run(Subject, Re, [{capture,none}]) of
                nomatch ->
                        do_re(Subject, Rest);

                match ->
                        temp
        end.

From the re module, options "capture none" is used to only returns if the re match, and not the part that successfully match...
(this is simple optimisation, since we don't care about the matching part)

If we look at back at what we've done here, we can see that


fileType(File) ->
        any( File, [ 
                        {fun word_temp/1, fun filename:basename/1}, 
                        {fun db_extension/1, fun lists:reverse/1},
                        {fun excel_temp/1, fun filename:basename/1}
                ]).

can really easily extended with other functions, as long as those new functions take only one parameter...


fileType(File) ->
        any( File, [ 
                        {fun word_temp/1, fun filename:basename/1}, 
                        {fun db_extension/1, fun lists:reverse/1},
                        {fun excel_temp/1, fun filename:basename/1},
                        {fun firefox_temp/1, fun filename:basename/1},
                        {fun directory_temp/1, fun(X) -> X end}
                ]).

Conclusion:
Building list of functions is an efficient way of "testing many conditions".

erlang: how to make a windows service

2009-08-18T22:01:00.006+02:00

Tired of fighting with the command line to make erlsrv work ?
I have a solution for you !
The problem are always the quotes, you have quotes for erlang and quotes for the windows command line...
Here's what I use to test my service:

(Pack everything in a simple "install.bat")


erlsrv remove "YourService"
erlsrv add "YourService" -stopaction "init:stop()." -sname Service -debugtype reuse -args "-kernel error_logger {file,\\""C:/Test/kernel.txt\\""} -setcookie YourCookie -s YourInit"

YourInit is the name of the module you want to start. The fun "start/0" will be called by "erl".

This install.bat is meant to be your debug version of your service, because the log file will grow indefinitely.

See the documentation for more information:

DebugType: Can be one of none (default), new, reuse or console. Specifies that output from the Erlang shell should be sent to a "debug log". The log file is named "servicename".debug or "servicename".debug."n", where "n" is an integer between 1 and 99. The log-file is placed in the working directory of the service (as specified in WorkDir). The reuse option always reuses the same log file ("servicename".debug) and the new option uses a separate log file for every invocation of the service ("servicename".debug."n"). The console option opens an interactive Windows® console window for the Erlang shell of the service.
The console option automatically disables the StopAction and a service started with an interactive console window will not survive logouts, OnFail actions do not work with debug-consoles either. If no DebugType is specified (none), the output of the Erlang shell is discarded.
The consoleDebugType is not in any way intended for production. It is only a convenient way to debug Erlang services during development. The new and reuse options might seem convenient to have in a production system, but one has to take into account that the logs will grow indefinitely during the systems lifetime and there is no way, short of restarting the service, to truncate those logs. In short, the DebugType is intended for debugging only. Logs during production are better produced with the standard Erlang logging facilities.

If you don't define the "WorkDir" (-w option) your debug file will be located in the "WINDOWS\system32" directory.

Finally, the service will be described in the registry in


HKEY_LOCAL_MACHINE\SOFTWARE\Ericsson\Erlang\ErlSrv\1.1\YourService

erlang: Extracting values from binary streams with macros

2009-08-17T22:10:00.004+02:00

Writing a lot of binary matching strings, I now use simple macros to synchronise erlang code with others language...
Let me explain a bit, there were many lines who look like theses:


parse(<< Id:32/little-unsigned, Oid:32/little-unsigned, Soid:16/little-unsigned >>, State) ->
 ...

Now I really prefer to see lines looking like this:


parse(<< ?UINT32( Id ),
                  ?UINT32( Oid ),
                  ?UINT16( Soid ) >>, State) ->
 ...

The magic trick was to define macros at the beginning of the erl module like this:


-define( UINT32(X),  X:32/little-unsigned).
-define( UINT16(X),  X:16/little-unsigned).

Now everyone can read those parse lines easily...

erlang: Unicode support for your filenames...

2009-08-17T21:56:00.005+02:00

From R13B you have full unicode support for strings.

I'm involved in some kind of interface between the windows kernel and an erlang vm, and I find this "unicode" module really
helpful.

For your information, internally every file path or file name is encoded as a little endian utf16 string in the windows kernel.
Exchanging information between those two world means that you'll have to convert utf16 into ansi strings.

For example you can create an utf16 binary string using this


unicode:characters_to_binary("your string" latin1, {utf16,little}).

This means that your string is "latin1" and you want a binary utf16 little endian encoded.
Really easy !

Here's some free code that let you easily manipulate file paths and filenames...
I hope this will help someone :p


-module(filename_utils).

-export([extension/1, basename/1, dirname/1]).
-export([normalize/1, utf16toansi/1]).
-export([test/1]).


extension(Bin) ->
        filename:extension( utf16toansi(Bin) ).

basename(Bin) ->
        filename:basename( utf16toansi(Bin) ).

dirname(Bin) ->
        filename:nativename(  filename:dirname( utf16toansi(Bin) ) ).

test(Mode) ->
        Word = "C:\\Program Files\\WINWORD.EXE",
        File = unicode:characters_to_binary(Word, latin1, {utf16,little}),
        ?MODULE:Mode( File ).

utf16toansi(Bin) ->
        unicode:characters_to_list(Bin, {utf16,little}).

normalize(File) when is_list(File) ->
        Path = filename:dirname(File),
        Base = filename:basename(File),
        Ext = filename:extension(File),
        {Base, Path, Ext};

normalize(Bin) when is_binary(Bin) ->
        Path = dirname(Bin),
        Base = basename(Bin),
        Ext = extension(Bin),
        {Base, Path, Ext}.

CEAN 1.4 is released

2008-11-03T09:06:00.004+01:00

Tdoay is a great day, today you can read on the erlang mailling list that "CEAN 1.4 is released" ! ( this time it's R12B4 based release )
There's also a new website, new design and new Cean packages.

Go grab it !

Secure Cookies for your web application...

2008-10-18T19:57:00.004+02:00

Now that new erlang web framework are here, I think that sessions are still today a weakness.

Session and Cookies must be secure, there's no single day without some new vulnerability about session hijacking.

That's why very clever people design the secure cookie protocol [PDF].

Here's the Cookie value:

user name|expiration time|(data)k|HMAC( user name|expiration time|data|session key, k)

where

k=HMAC(user name|expiration time, sk)

and where sk is a secret key

Now you can verify the cookie using theses techniques:

1. Compare the cookie’s expiration time and the server’s current
  time. If the cookie has expired, then return FALSE.
2. Compute the encryption key as follows:
 k=HMAC(user name|expiration time, sk)
3. Decrypt the encrypted data using k.
4. Compute HMAC(user name|expiration time|data|session key, k),
 and compare it with the keyed-hash message authentication code
 of the cookie. If they match, then return TRUE;
 otherwise return FALSE.
 TRUE

Here's the erlang module

-module(scookies).
-export([start/0, gen_auth/1, gen_build/2, gen_check/2, read/1, check/4, test/0]).
-export([message/1]).

start() ->
 application:start(crypto).

gen_build(ServerKey, IVec) ->
 fun(Username, D, SessionKey) ->
  Expiration = integer_to_list(1212559656),
  Key = crypto:md5_mac( [Username, Expiration], ServerKey), %16bytes
  Data = crypto:aes_cbc_128_encrypt(Key, IVec, D),
  Hmac = crypto:sha_mac([Username, Expiration, Data, SessionKey], Key),
  io:format("Build: ~p ~p ~p ~p ~p~n",[Username, Expiration, Data, SessionKey, Key]),
  iolist_to_binary([ Username, $,, Expiration, $,, Data, $,, Hmac ])
 end.

read(Cookie) ->
 {A, B, C} = Cookie,
 {A, B, C}.

 
gen_check(ServerKey, IVec) ->
  fun(Cookie, SessionKey) ->
  [ Username, Expiration, Crypted, Hmac ] = string:tokens(binary_to_list(Cookie), ","),
  Key = crypto:md5_mac([ Username, Expiration ], ServerKey),
  Data = crypto:aes_cbc_128_decrypt(Key, IVec, Crypted),
  MAC = crypto:sha_mac([ Username, Expiration, Crypted, SessionKey], Key),
  io:format("Check: ~p ~p ~p ~p ~p~n",[Username, Expiration, Data, SessionKey, Key]),
  <<Len:16,Message:Len/binary,_/binary>> = Data,
  io:format("Decrypted: ~p '~s'~n'~p'~n'~p'~n", [Len, Message, MAC, list_to_binary(Hmac)]),
  [ Username, Expiration, {Len, Message}, MAC, list_to_binary(Hmac)]
 end.

% Returns the build fun and check fun 
% This is a helper fun to let you build in q simple way bot the build fun and
% the decode fun...
gen_auth(ServerKey) -> 
 IVec = <<"3985928509201031">>, %16bytes Must be Random
 [ gen_build(ServerKey, IVec), gen_check(ServerKey, IVec) ].
 

check(Cookie, ServerKey, InitVec, SessionKey) ->
 {Username, ExpirationTime, Crypted, CookieMAC} = read(Cookie),
 case check_time(ExpirationTime) of % see later check_time...
  ok ->
   Key = crypto:sha_mac([ Username, ExpirationTime ], ServerKey),
   Data = crypto:aes_cbc_128_decrypt(Key, InitVec, Crypted),
   MAC = crypto:sha_mac([ Username, ExpirationTime, Data, SessionKey], Key),
   compare(MAC, CookieMAC, Data);

  _E -> 
   {error, _E}
 end.

compare(_A, _A, Data) ->
 {ok, Data};
compare(_A, _B, _Data) ->
 {error, nomatch}.

check_time(1212559656) -> % It's up to you to set it 
 true;
check_time(_) ->
 false.

message(Text) ->
 Len = size(Text),
 Pad = 64 - Len - 2,
 <<Len:16,Text/binary, 0:Pad/unit:8>>.
 
test() ->
 ServerKey = <<"serverkey">>,
 SessionKey = <<"3ID409a0sd09">>,
 [ Enc, Dec ] = gen_auth(ServerKey),
 CCookie = Enc("rolphin", message(<<"stream/128693">>), SessionKey), 
 DCookie = Dec(CCookie, SessionKey),
 io:format("C: ~s~n", [ CCookie ]),
 display(DCookie).

display([Username, Expiration, {Len, Message}, _Mac, _Mac]) ->
 io:format("Message ok: ~s (~s) ~p: '~s'~n", [Username, Expiration, Len, Message]);
display([Username, Expiration, {Len, Message}, _Mac, _OtherMac]) ->
 io:format("Invalid Mac ! ~s (~s) ~p: '~s'~n", [Username, Expiration, Len, Message]).

Benchmarking must be done carefully !

2008-10-09T18:27:00.003+02:00

An example is better than a long post !

Timeout were hidden, smp by default modified the expected behaviour, and more...
Don't assume things, just take time to verify :)

Explained here

From the beginning:
started here

gen_fsm vs a simple fsm for sending emails...

2008-09-28T20:34:00.007+02:00

I needed to send emails, and check for emails validity.
I choose to use at the beginning the gen_fsm used to send email, for
example this one.

I found that I just need a simple fun that just send a mail, and don't want a full gen_fsm that need to be called for every steps involved in sending a simple mail...

I needed a way to mail efficiently, by efficiently I mean:
- the mx server will be contacted directly
- if one mx server fail try another one
- handle the greylisting transparently, ( don't block the send queue for one message )

My fun then becomes:


start_link(Server,Port,ServerName,MailFrom,To,Data) ->
  spawn_link(?MODULE, init, [Server,Port,ServerName,MailFrom,To,Data]).

And my module gets a name 'smtp_client'.

While hacking with the gen_fsm above, I've found that there was no binary strings usage at all,
manipulations are all done using lists... The binary type fit perfectly for this task so I've used
it instead.

So, I've rewrote everything, I've build a simple "smtp_proto.erl" file that just send binary strings for every state in the smtp protocol, and wait for a smtp response from the server. And write a simple "smtp_client.erl" that use only one single loop and call the needed "StateName" fun whenever it is needed.

Here's the loop fun, where everything takes place:


loop(Phase,State) ->
 receive 
  {'$c', Who, info} ->
   Who ! {ok, Phase, State#state.to},
   loop(Phase, State); 

  {'$c', stop} ->
   error_logger:info_msg("Forced to quit~n"),
   [_,_, Email ] = State#state.to,
    exit({stop, Email});

  {tcp, Socket, Data} ->
   [_,_, Email ] = State#state.to,
   case smtp_proto:check(Data) of
    {more, _Rest} ->
     inet:setopts(Socket, [{active,once}]),
     loop(Phase, State);

    {ok, _Rest} ->
      inet:setopts(Socket, [{active,once}]),
     case ?MODULE:Phase({Socket, Data}, State) of

      {ok, NewPhase, NewState} ->
       loop(NewPhase, NewState);
 
      {stop, success, _NewState} ->
       mail_stats:add(success),
       exit({ok, Email});

      {stop, How, _NewState} ->
       exit({How, Email});

      {error, _NewPhase, _NewState} ->
       error_logger:error_msg("Error: ~p '~p'~n", [Phase, Email]),
       exit({error, Email});

      _Any ->
       error_logger:msg("What: ~p~n", [_Any]),
       exit({error, _Any})
     end;

    {error, 421, Rest} ->
     error_logger:error_msg("Error ~p for ~s (greylist): ~p ~p~n", [Phase, Email, 421, Rest]),
     greylist(State),
     exit({error, Rest});
     
    {error, Code, Rest} ->
     error_logger:error_msg("Error ~p for ~s: ~p ~p~n", [Phase, Email, Code, Rest]),
     exit({error, Rest});

    {error, Rest} ->
     error_logger:error_msg("Error ~p for ~s: ~p~n", [Phase, Email, Rest]),
     exit({error, Rest}) 
   end;  

  {tcp_error, _Socket, timeout} ->
   [_,_, Email ] = State#state.to,
   error_logger:error_msg("Error: ~p 'timeout' for ~s~n", [Phase, Email]),
   exit({error, timeout});
   
  {tcp_closed, _Socket} ->
   [_,_, Email ] = State#state.to,
   error_logger:error_msg("Error: ~p 'connection closed' for ~s~n", [Phase, Email]),
   exit({error, closed});

  _Any ->
   error_logger:error_msg("Unhandled message: ~p~n", [_Any]),
   loop(Phase,State) 

 after ?INACTIVITY ->
  exit({error, inactivity})
 end.

What's important here, is that the gen_tcp sends various messages to the process,
and those messages controls the state of the fsm.


    {ok, _Rest} ->
      inet:setopts(Socket, [{active,once}]),
     case ?MODULE:Phase({Socket, Data}, State) of

My module "smtp_client" calls a fun "Phase" which correspond to a SMTP state...


loop(Phase,State) ->
...
    {ok, _Rest} ->
      inet:setopts(Socket, [{active,once}]),
     case ?MODULE:Phase({Socket, Data}, State) of
      {ok, NewPhase, NewState} ->
       loop(NewPhase, NewState);

Let's take a look at the helo fun:


helo({Socket, _Data}, State) ->
 smtp_proto:mailfrom(Socket, State#state.mailfrom),
 {ok, mailfrom, State}.

It's job is simply calling "smtp_proto:mailfrom" and returning the tuple "{ok, mailfrom, State}".
Then in the main loop the consequence is:


     case ?MODULE:Phase({Socket, Data}, State) of
      {ok, NewPhase, NewState} ->
       loop(NewPhase, NewState);

NewPhase = mailfrom, and NewState = State...

Now the mailfrom fun use exactly the same method:


mailfrom({Socket, _Data}, State) ->
 [_,_,Email] = State#state.to,
     smtp_proto:rcptto(Socket, Email),
 {ok, rcptto, State}.

The fun extract the email, then call the "smtp_proto:rcptto" on the Socket with the argument Email.
Technically, it just write this on the Socket:


RCPTO TO:<Email>\r\n

Then it returns the tuple holding the new Phase "rcptto" and the new State (which is the same unmodified)

So what's nice with this method, is that every tcp related
actions are handled within only one and only loop. None of Phase fun need
to catch {tcp_ messages or handle tcp disconnections.

The last thing before the full code, remember the mx trick that returns a list of valid servers.
Then you'll understand why the start_link fun takes a list of servers as first parameter...
(if one mx is down, connect to the next one)

Now the full source code:


-module(smtp_client).

-record(state,{
 socket,
 servername,
 mailfrom, to,
 data }).

%% Extra long timeout for strange SMTPs...
-define(TIMEOUT, 10000).
-define(INACTIVITY, 100000).
-define(GREYSLEEP, 300000).   %5 minutes

% States
-export([connect/2,helo/2,mailfrom/2,rcptto/2,data/2,quit/2]).

%% External Exports
-export([start_link/1,start_link/6,stop/1]).

%% gen_server callbacks
-export([init/6]).


%%%----------------------------------------------------------------------
%%% API
%%%----------------------------------------------------------------------
% Manual Start

% Supervised Start
start_link(Server,Port,ServerName,MailFrom,To,Data) ->
 spawn_link(?MODULE, init, [Server,Port,ServerName,MailFrom,To,Data]).

stop(Pid) ->
 Pid ! {'$c', stop}.
 
%%%----------------------------------------------------------------------
%%% HELO State
%%%----------------------------------------------------------------------
 
helo(timeout, State) ->
 error_logger:error_msg("helo timeout (~p)~n", [State]),
  {stop, normal, State};

helo({timeout, _Ref, Reason}, State) ->
 [_,_,Email] = State#state.to,
 error_logger:error_msg("Timeout: ~p email: '~s'~n", [Reason, Email]),
  {stop, normal, State};

 
helo({Socket, _Data}, State) ->
 smtp_proto:mailfrom(Socket, State#state.mailfrom),
 {ok, mailfrom, State}.


%%
%% Right after the connection... 
%%
connect({Socket, _Data}, State) ->
 smtp_proto:helo(Socket, State#state.servername),
 {ok, helo, State}.


%%%----------------------------------------------------------------------
%%% MAILFROM State
%%%----------------------------------------------------------------------
 
mailfrom(timeout, State) ->
 error_logger:error_msg("timeout (~p)~n", [State]),
  {stop, normal, State};

mailfrom({timeout, _Ref, Reason}, State) ->
 [_,_,Email] = State#state.to,
 error_logger:error_msg("Timeout: ~p email: '~s'~n", [Reason, Email]),
  {stop, normal, State};

mailfrom({Socket, _Data}, State) ->
 [_,_,Email] = State#state.to,
     smtp_proto:rcptto(Socket, Email),
 {ok, rcptto, State}.

%%%----------------------------------------------------------------------
%%% RCPT TO State
%%%----------------------------------------------------------------------

rcptto(timeout, State) ->
 error_logger:error_msg("rcptto timeout (~p)~n", [State]),
  {stop, normal, State};

rcptto({timeout, _Ref, Reason}, State) ->
 [_,_,Email] = State#state.to,
 error_logger:error_msg("Timeout: ~p email: '~s'~n", [Reason, Email]),
  {stop, normal, State};

rcptto({Socket, _Data}, State) ->
       smtp_proto:data(Socket),
   {ok, data, State}.

%%%----------------------------------------------------------------------
%%% DATA State
%%%----------------------------------------------------------------------

data(timeout, State) ->
 error_logger:error_msg("data timeout (~p)~n", [State]),
  {stop, normal, State};

data({timeout, _Ref, Reason}, State) ->
 [_,_,Email] = State#state.to,
 error_logger:error_msg("Timeout: ~p email: '~s'~n", [Reason, Email]),
  {ok, data, State};

data({Socket, _Data}, State) ->
 smtp_proto:write(Socket, [ State#state.data, <<"\r\n.">> ]),
 {ok, quit, State}.
 
%%%----------------------------------------------------------------------
%%% QUIT State
%%%----------------------------------------------------------------------

quit(timeout, State) ->
 error_logger:error_msg("data timeout (~p)~n", [State]),
  {stop, normal, State};

quit({_Socket, _Data}, State) ->
  [_,_,Email] = State#state.to,
 smtp_proto:quit(State#state.socket),
  error_logger:info_msg("Sent to ~s : OK~n", [Email]),
  {stop, success, State}.

%%%----------------------------------------------------------------------
%%% Callback functions from gen_fsm
%%%----------------------------------------------------------------------
%% Timeout from ?TIME
%% gen_fsm:start_timer(70000, slow),

init(Servers,Port,ServerName,MailFrom,To,Data) ->
 process_flag(trap_exit, true),
 connect(Servers,Port,ServerName,MailFrom,To,Data).

connect([], _,_,_,To,_) ->
 [_,_,Email] = To,
 exit({error, Email});

connect([H | T],Port,ServerName,MailFrom,To,Data) ->
 case gen_tcp:connect(H,Port,[binary,{packet,0},{active,once}], ?TIMEOUT) of 
  {ok,Socket} ->
   inet:setopts(Socket, [{active,once}]),
   loop(connect, #state{ 
     socket=Socket,
     servername=ServerName,
     to=To,
     mailfrom=MailFrom,
     data=Data});
  {error, timeout} ->
   connect(T,Port,ServerName,MailFrom,To,Data);

  {error, Reason} ->
   exit({error, Reason})
 end.

loop(Phase,State) ->
 receive 
  {'$c', Who, info} ->
   Who ! {ok, Phase, State#state.to},
   loop(Phase, State); 

  {'$c', stop} ->
   error_logger:info_msg("Forced to quit~n"),
   [_,_, Email ] = State#state.to,
    exit({stop, Email});

  {tcp, Socket, Data} ->
   [_,_, Email ] = State#state.to,
   case smtp_proto:check(Data) of
    {more, _Rest} ->
     inet:setopts(Socket, [{active,once}]),
     loop(Phase, State);

    {ok, _Rest} ->
      inet:setopts(Socket, [{active,once}]),
     case ?MODULE:Phase({Socket, Data}, State) of

      {ok, NewPhase, NewState} ->
       loop(NewPhase, NewState);
 
      {stop, success, _NewState} ->
       mail_stats:add(success),
       exit({ok, Email});

      {stop, How, _NewState} ->
       exit({How, Email});

      {error, _NewPhase, _NewState} ->
       error_logger:error_msg("Error: ~p '~p'~n", [Phase, Email]),
       exit({error, Email});

      _Any ->
       error_logger:msg("What: ~p~n", [_Any]),
       exit({error, _Any})
     end;

    {error, 421, Rest} ->
     error_logger:error_msg("Error ~p for ~s (greylist): ~p ~p~n", [Phase, Email, 421, Rest]),
     greylist(State),
     exit({error, Rest});
     
    {error, Code, Rest} ->
     error_logger:error_msg("Error ~p for ~s: ~p ~p~n", [Phase, Email, Code, Rest]),
     exit({error, Rest});

    {error, Rest} ->
     error_logger:error_msg("Error ~p for ~s: ~p~n", [Phase, Email, Rest]),
     exit({error, Rest}) 
   end;  

  {tcp_error, _Socket, timeout} ->
   [_,_, Email ] = State#state.to,
   error_logger:error_msg("Error: ~p 'timeout' for ~s~n", [Phase, Email]),
   exit({error, timeout});
   
  {tcp_closed, _Socket} ->
   [_,_, Email ] = State#state.to,
   error_logger:error_msg("Error: ~p 'connection closed' for ~s~n", [Phase, Email]),
   exit({error, closed});

  _Any ->
   error_logger:error_msg("Unhandled message: ~p~n", [_Any]),
   loop(Phase,State) 

 after ?INACTIVITY ->
  exit({error, inactivity})
 end.

greylist(State) ->
 spawn(greylist, start, [ ?GREYSLEEP, State#state.servername,
  State#state.mailfrom,State#state.to,State#state.data]).

Here's the smtp_proto module:


-module(smtp_proto).
-export([read/1, 
 read/2, 
 write/2,
 helo/2,
 ehlo/2,
 mailfrom/2,
 rcptto/2,
 data/1,
 noop/1,
 rset/1,
 help/1,
 check/1,
 quit/1]).

read(Socket) ->
 read(Socket, 5000).

read(Socket, Timeout) ->
 case gen_tcp:recv(Socket, 0, Timeout) of
  {ok, Packet} ->
   check(Packet);

  {error, Why} ->
   {error, Why} 
 end.

%% 2XX codes are OK
check(<<"250 ", Rest/binary>>) ->
 {ok, Rest};
check(<<"214", Rest/binary>>) ->
 {ok, Rest};
check(<<"220", Rest/binary>>) ->
 {ok, Rest};
check(<<"221", Rest/binary>>) ->
 {ok, Rest};
check(<<"354", _Rest/binary>>) ->
 {ok, data};

%Errors
check(<<"421", Rest/binary>>) ->
 {error, 421, Rest};
check(<<"503", Rest/binary>>) ->
 {error, 503, Rest};
check(<<"511", Rest/binary>>) ->
 {error, 511, Rest};
check(<<"540", Rest/binary>>) ->
 {error, 540, Rest};
check(<<"550", Rest/binary>>) ->
 {error, 550, Rest};
check(<<"554", Rest/binary>>) ->
 {error, 554, Rest};
check(Bin) ->
 {more, Bin}.

write(Socket, Msg) ->
 gen_tcp:send(Socket, [Msg, <<"\r\n">>] ).

helo(Socket, Name) ->
 Msg = [ <<"HELO ">>, Name ],
 write(Socket, iolist_to_binary(Msg)).

ehlo(Socket, Name) ->
 Msg = [ <<"EHLO ">>, list_to_binary(Name) ],
 write(Socket, Msg).

rcptto(Socket, Name) ->
 Msg = iolist_to_binary([ <<"RCPT TO:<">>, Name, <<">">> ]),
 write(Socket, Msg).

mailfrom(Socket, Name) ->
 Msg = [ <<"MAIL FROM:<">>, list_to_binary(Name), <<">">> ],
 write(Socket, Msg).

help(Socket) ->
 Msg = <<"HELP">>,
 write(Socket, Msg).

noop(Socket) ->
 Msg = <<"NOOP">>,
 write(Socket, Msg).

quit(Socket) ->
 Msg = <<"QUIT">>,
 write(Socket, Msg).

rset(Socket) ->
 Msg = <<"RSET">>,
 write(Socket, Msg).

data(Socket) ->
 Msg = <<"DATA">>,
 write(Socket, Msg).

But wait ! There's more !
BONUS: the greylist client
(where you can see the smtp_client in action):


-module(greylist).

-export([start/5, stop/1, flush/1]).
-define(TIMEOUT, 100000).

start(Sleep,ServerName,MailFrom,To,Data) ->
        receive 
                {'$c', flush} ->
                        ok;

                {'$c', stop} ->
                        error_logger:info_msg("~p: Manual stop~n", [?MODULE]),
                        exit(normal)
        after Sleep -> 
                ok 
        end,
        [ _, _, Email ] = To,
        [ _, Domain ] = string:tokens( Email, "@"),
        List = mmailer:get_mx(Domain),
        {_, Servers} = lists:unzip( lists:keysort(1, List) ),
        Pid = smtp_client:start_link(Servers, 25, ServerName,MailFrom,To,Data),
        loop(Pid).

flush(Pid) ->
        Pid ! {'$c', flush}.

stop(Pid) ->
        Pid ! {'$c', stop}.

loop(Child) ->
        receive 
                {'$c', stop} ->
                        smtp_client:stop(Child),
                        error_logger:info_msg("Greylist: Manual stop~n");

                {'EXIT', Child, Reason} ->
                        error_logger:info_msg("~p child ~p died : ~p~n", [?MODULE, Child, Reason]);
                
                {'EXIT', Pid, Reason} ->
                        error_logger:info_msg("~p not own child ~p died : ~p~n", [?MODULE, Pid, Reason]),
                        loop(Child);

                Msg -> 
                        error_logger:error_msg("~p: Unhandled message received: '~p'", [?MODULE, Msg]),
                        loop(Child) 

        after ?TIMEOUT ->
                smtp_client:stop(Child)
        end.

From Googerl to googleatom_app

2008-07-15T10:42:00.003+02:00

Hi, (a quick post)
I've been busy this weekend working on a more generic layer for google API. Here comes the 'googleatom_app'.

I've uploaded it in the googerl project.
The application needs 'crypto, ssl, inets' to work.

[ application:start(X) || X <- [crypto, ssl, inets, googleatom] ]

should start the application.
There's currently not much documentation, this is still at a very early stage. Here's a list of what you can do now:

Post an article into blogger
Post a photo into picasa, taken from a file or from a URL (inets download the image and send it to picasa)

Once the application has started, you'll see two new registered processes 'blogger_srv' and 'picasa_srv'. The first thing you need to do before being able to use thoses process is setting your google credentials:

picasa_srv:auth(Username, Password).

Once the call returns you'll receive a google token string. If not you'll have to investigate a little :).
Ok now that you're authenticated you can post a nice photo into your gallery:

picasa_srv:new(Username, Album, "http://www.aniceimageservier.com/superimage.jpg", "Fake Image Name").

Since the process of posting images takes time, picasa_srv uses 'gen_server:cast', and now the success is indicated by some 'error_logger:info_msg' ... (xmerl is used to extract various new urls of your posted photo).

That's it for this really quick introduction, I'll will update files within days, actually some funs are not available everywhere, I'll fix this.

I'll post a googleatom_app tutorial later this week...

My mochiweb webservice...

2008-07-10T08:57:00.006+02:00

Now that mochiweb is popular, and that I use it for some of my work, I can publish here some webservice thingy that I use.

I wanted to have this simple thing: modulename,funname, and parameters inside the URL:


http://www.server.tld/modulename/fun/arg1/arg2 
wmodulename:Fun(arg1, arg2)

(Note the 'w' prefix, I explain it later)

Here's the code:


-module(webservice).
-export([start/0, start/2, loop/2, stop/0, test/0]).
-export([dolog/2]).
-define(PORT, 8080).

start() ->
 start("/home/rolphin/Devel/Web", ?PORT).

start(Wwwroot, Port) ->
 Loop = fun (Req) ->
  ?MODULE:loop(Req, Wwwroot)
 end,
 mochiweb_http:start([{loop, Loop}, {name, ?MODULE}, {port, Port}]).

stop() ->
    mochiweb_http:stop(?MODULE).

loop(Req, DocRoot) ->
 log(Req),
 case string:tokens(Req:get(path), "/") of
  [ "dump" ] ->
   Req:ok({"text/plain",
    io_lib:format("~p~n", [Req:dump()])});

  [ "favicon.ico" ] ->
   Req:respond({404, [], ""});

  [ "codepath" ] ->
   Req:ok({"text/plain",
    io_lib:format("codepath: ~p~n", [code:get_path()])});

  [ "codepath", "json" ] ->
   Req:ok({"text/plain",
    mochijson:encode({array, code:get_path()})});

  [ Path, Fun | Elems ] ->
   % Every module name should begin with 'w'
   dispatch(Req, DocRoot, list_to_atom("w" ++ Path), Fun, Elems);

  [] ->
   launch(Req, DocRoot, wdefault, do, []);

  _ ->
   Req:respond({502, [], []})
   
 end.

dispatch(Req, DocRoot, Module, Fun, Elems) ->
 M = Req:get(method),
 case M of
  'GET' ->
   launch(Req, DocRoot, Module, Fun, Elems);
  'POST' ->
   launch(Req, DocRoot, Module, Fun, Elems);
  'PUT' ->
   launch(Req, DocRoot, Module, Fun, Elems);
  'DELETE' ->
   launch(Req, DocRoot, Module, Fun, Elems);
  'HEAD' ->
   launch(Req, DocRoot, Module, Fun, Elems);
  _Any ->
   launch(Req, DocRoot, wdefault, get, [])
 end.

launch(Req, DocRoot, wcontent, Fun, Args) ->
 case catch wcontent:default(Req, DocRoot, [ Fun | Args] ) of
  {'EXIT', {Type, _Error}} ->
   Req:ok({"text/plain",  
    io_lib:format("GET Error: '~p' for '~p' ~p ~p~n~p~n", [Type, wcontent, Fun, Args, _Error])});
  _ ->
   ok
 end;
 
launch(Req, DocRoot, Module, Fun, Args) ->
 F = list_to_atom(Fun),
 case catch Module:F(Req, DocRoot, Args) of
  {'EXIT', {Type, _Error}} ->
   Req:ok({"text/plain",  
    io_lib:format("~p Error: '~p' for ~p ~p ~p~n~p~n", [Req:get(method), Type, Module, Fun, Args, _Error])});
  _ ->
   ok
 end.

log(Req) ->
 Ip = Req:get(peer),
 spawn(?MODULE, dolog, [Req, Ip]).

dolog(Req, Ip) ->
 stat_logger:log("~p ~p", [Ip, Req:get(path)]).

First you can see that I use "mochiweb:start" and "mochiweb:stop" in the "start" and "stop" funs.
Then parameters are extracted from the URI:


 case string:tokens(Req:get(path), "/") of

I split the URI on the "/" character, and compare the resulting list with various possibilities.

Then the main part of the code:


launch(Req, DocRoot, Module, Fun, Args) ->
 F = list_to_atom(Fun),
 case catch Module:F(Req, DocRoot, Args) of
  {'EXIT', {Type, _Error}} ->
   Req:ok({"text/plain",  
    io_lib:format("~p Error: '~p' for ~p ~p ~p~n~p~n", [Req:get(method), Type, Module, Fun, Args, _Error])});
  _ ->
   ok
 end.

Using "catch" prevent your app from crashing without any information. If a module doesn't exists, you'll be able to see why (the main problem is sometimes the module is not in the code:path...)

Every webservice module name should start with "w", it's some sort of namespace :), now you know the reason for the 'w' prefix:


  [ Path, Fun | Elems ] ->
   % Every module name should begin with 'w'
   dispatch(Req, DocRoot, list_to_atom("w" ++ Path), Fun, Elems);

Now, how can I use it ? It's simple, you just have to build a module with such a template:


-module(wsample).
-export([do/3]).

do(Req, _DocRoot, Args) ->
 Req:ok({"text/plain", [ <<"Hello ">>, hd(Args) , <<", you are authorized :)">>] }).

Then you build it, and store it somewhere in your "code:path". And call


webservice:start().

in your erl shell. Then locate your webrowser to the URI

www.server.tld:8080/sample/do/PUT-ANYTHING-YOU-WANT-HERE

As a sample module, here is a module that is used everyday the "mobile tags" generator:


-module(wbarcode).
-export([do/3]).

-define(PNG, "image/png").

do(Req, _DocRoot, _Args) ->
 barcode(Req).

% the process 'barcode' must be there
barcode(Req) ->
 Options = Req:parse_qs(),
 %io:format("~p~n", [Options]),

 Text = proplists:get_value("text", Options, "http://www.shootit.fr"),
 Res = proplists:get_value("res", Options, "72"),
 Z = proplists:get_value("z", Options, "1"),

 case barcode:generate('barcode', Text) of 
  timeout ->
   Req:ok({"text/plain", [], <<"Timeout">>});
  
  {data, {Width, Height}, Data} ->
   Zoom = list_to_integer(Z),
   Xres = integer_to_list(list_to_integer(Res)  * Zoom),
   Yres = integer_to_list(list_to_integer(Res)  * Zoom),
   Params = [ {"PS", [integer_to_list(Width + 1), integer_to_list(Height + 1)]}, {"HW", [Xres, Yres]} ],
   case gs:draw(gs, Data, Params) of
    {png, Image} ->
     Req:ok({?PNG, Image});

    _E ->
     Req:ok({"text/plain", [], [ <<"Error: ">>, 
      io_lib:format("~s", [_E])]})
   end
 end.

Dealing with multiple pages of results easily

2008-07-09T16:25:00.004+02:00

We you want to deal with multiples pages of responses and using MySQL, you are always dealing with some sort of "LIMIT" statement. Since erlang is a vm, you can efficiently retrieving results while the user is not asking you to... You can transparently in the background prefetch data for him. This is what I call a pager.

I've build simple module to that for me :


-module(db_pager).
-export([retrieve/1, loop/2]).

new(Request, Start, Step) ->
 Prepared = 
 Pid = spawn(?MODULE, loop, [Start, Step]),
 retrieve(Pid),

retrieve(Pid) ->
 io:format("DEBUG: ~p ! {next, ~p}~n", [ Pid, self() ]),
 Pid ! { next, self() },
 receive
  {eof, Msg} ->
   io:format("eof: ~p~n", [Msg]),
   {eof, Msg};

  {data, Data} ->
   io:format("Received: ~p~n", [Data]),
   timer:sleep(3000),
   retrieve(Pid); 

  stop ->
   stop;

  _E ->
   io:format("Unhandled: ~p~n", [_E]),
   client(Pid) 
 after 2000 ->
  timeout
 end.

select(Fields, Table) ->
 [ Head | Rest ] = Fields,
 [ <<"select ">>, atom_to_list(Head),
  lists:foldl(fun(X, Acc) ->
   [ [ <<",">> |  atom_to_list(X) ] | Acc ]
   end, [], Rest),
  <<" from ">>, atom_to_list(Table) ].

sql(Current, Step) ->
 Query = select([id,lastname,firstname], users),
 Next = Current + Step,
 case mysql:fetch(mysql, [ 
  Query, <<" where id between ">>, 
  integer_to_list(Current), <<" and ">>, integer_to_list(Next) ]) of

  {data, Data} -> 
   case mysql:get_result_rows(Data) of
    [] ->
     {eof, empty};

    Res ->
     %io:format("DEBUG: sql: data: ~p~n", [Data]),
     {data, Res}  
   end;

  {error, Data} -> 
   io:format("DEBUG: sql: data: ~p~n", [Data]),
   {eof, mysql:get_result_reason(Data)}
 end.

loop(Current, Step) ->
 loop(Current, Step, []).

loop(Current, Step, []) ->
 Res = sql(Current, Step),
 loop(Current + Step, Step, Res);

loop(Current, Step, Res) ->
 Next = Current + Step,
 receive
  {next, Who} ->
   Who ! Res,
   NewRes = sql(Current, Step),
   loop(Next, Step, NewRes);

  stop ->
   stop

 after 30000 ->
  timeout
 end.

This code build a sql query that contains some "BETWEEN" statement for some "id" field:


 Query = select([id,lastname,firstname], users),
 Next = Current + Step,
 case mysql:fetch(mysql, [ 
  Query, <<" where id between ">>, 
  integer_to_list(Current), <<" and ">>, integer_to_list(Next) ]) of

This part specifically builds a string like this:


select id,lastname,firstname where id between X and Y

Where X and Y are variable, X stands for the Current offset and Y the Next offset.

When the code is called multiple times the X and Y are automatically computed, so every row from the table will be returned one page (Y - X elems) at a time. The "loop/1" function is here for that:


loop(Current, Step, Res) ->
 Next = Current + Step,
 receive
  {next, Who} ->
   Who ! Res,
   NewRes = sql(Current, Step),
   loop(Next, Step, NewRes);

  stop ->
   stop

 after 30000 ->
  timeout
 end.

The receiver Who will have informations one page at a time. The data sent to him is fetched before he needs to, except the first time:


loop(Current, Step, []) ->
 Res = sql(Current, Step),
 loop(Current + Step, Step, Res);

Monitoring your servers with sysstat (sar)

2008-07-09T11:44:00.005+02:00

There's sometimes things that are so helpfull that you think that everyone is aware of them, but sometimes this is not the case. Here I'll talk about a little package that is so powerful and efficient that you won't change anymore...
Taken from the ubuntu man page:


DESCRIPTION
       The sar command writes to standard output the contents of  selected  cumula-
       tive activity counters in the operating system. The accounting system, based
       on the values in the count and interval parameters, writes  information  the
       specified  number of times spaced at the specified intervals in seconds.  If
       the interval parameter is set to zero, the sar command displays the  average
       statistics  for the time since the system was started. The default value for
       the count parameter is 1. If its value is set to zero, then reports are gen-
       erated continuously.  The collected data can also be saved in the file spec-
       ified by the -o filename flag, in  addition  to  being  displayed  onto  the
       screen.  If filename is omitted, sar uses the standard system activity daily
       data file, the /var/log/sysstat/sadd file, where the dd parameter  indicates
       the  current  day.   By  default  all the data available from the kernel are
       saved in the data file. Exceptions are interrupts and disks data, for  which
       the  relevant  options  must  be explicitly passed to sar (or to its backend
       sadc ) when the data file is created (see options below).

"sar" comes with the sysstat package. Once it's installed you can monitor your server like never before...

Here's the description of the sysstat package from the author

The sysstat utilities are a collection of performance monitoring tools for Linux. 
These include sar, sadf, mpstat, iostat, pidstat and sa tools. Go to the Features page to display 
a list of sysstat's features, or see the Documentation page to learn some more about them.

For example, you can watch realtime the network usage:


# sar -n DEV 1 0
Linux 2.6.22-15-generic (xXxXx)  07/09/2008

11:26:36 AM     IFACE   rxpck/s   txpck/s    rxkB/s    txkB/s   rxcmp/s   txcmp/s  rxmcst/s
11:26:37 AM        lo      0.00      0.00      0.00      0.00      0.00      0.00      0.00
11:26:37 AM      eth0      5.05      0.00      0.86      0.00      0.00      0.00      0.00

11:26:37 AM     IFACE   rxpck/s   txpck/s    rxkB/s    txkB/s   rxcmp/s   txcmp/s  rxmcst/s
11:26:38 AM        lo      0.00      0.00      0.00      0.00      0.00      0.00      0.00
11:26:38 AM      eth0      4.00      0.00      0.45      0.00      0.00      0.00      0.00
...

Today, I'll introduce the erlang-sar package that's able to retrieve information from the sar command.

The application is composed of a collector "sar_collector", a helper module "sar_values" and the main module "sar".
Here comes a quick sample session:


% Starting the collector
sar_collect:start().

% Retrieving the data
sar:stats(cpu).
[{cpu,idle,<<"98.62">>},
 {cpu,steal,<<"0.00">>},
 {cpu,iowait,<<"0.00">>},
 {cpu,system,<<"0.18">>},
 {cpu,nice,<<"0.00">>},
 {cpu,user,<<"1.20">>}]

% Retrieving more data
sar:stats([cpu,mem]).
[{swap,swpcad,<<"33236">>},
 {swap,usage,<<"64.72">>},
 {swap,used,<<"389872">>},
 {swap,free,<<"212492">>},
 {mem,kbcached,<<"84496">>},
 {mem,kbbuffers,<<"63408">>},
 {mem,memused,<<"98.78">>},
 {mem,kbmemused,<<"508984">>},
 {mem,kbmemfree,<<"6308">>},
 {cpu,idle,<<"97.83">>},
 {cpu,steal,<<"0.00">>},
 {cpu,iowait,<<"0.75">>},
 {cpu,system,<<"0.20">>},
 {cpu,nice,<<"0.00">>},
 {cpu,user,<<"1.22">>}]

The module "sar_values" also export an "extractor" function that can be used to build fun()s:


% build a Mem fun()
Mem = sar_values:extractor(mem).

% Calling Mem fun() on sar:stats()
Mem(sar:stats([cpu,mem])).
[{kbcached,<<"84496">>},
 {kbbuffers,<<"63480">>},
 {memused,<<"98.77">>},
 {kbmemused,<<"508976">>},
 {kbmemfree,<<"6316">>}]

% Calling it on sar:stats()
Mem(sar:stats()).
[{kbcached,<<"84496">>},
 {kbbuffers,<<"63520">>},
 {memused,<<"98.80">>},
 {kbmemused,<<"509100">>},
 {kbmemfree,<<"6192">>}]

With this package you have access to all the data sar can export for you.
Here's the "sar.erl" code:


-module(sar).

-export([systat/0, stats/0, stats/1, option/1]).
-export([extract/1]).
-define(OPTIONS, "-u -r -v -c -q -n DEV").
-define(DATA, "/tmp/last").

systat() ->
 Cmd = "sadf " ++ ?DATA ++ " -- " ++ ?OPTIONS,
 execute(".", Cmd).

stats() ->
 Cmd = "sadf " ++ ?DATA ++ " -- " ++ ?OPTIONS,
 {ok, _, Bin} = execute(".", Cmd),
 extract(Bin).

stats(List) when is_list(List) ->
 Args = lists:foldl(fun(X, Acc) -> case option(X) of
     error ->
      Acc;
     T ->
      [ $ , T | Acc ]
    end end, [], List),
 Cmd = "sadf " ++ ?DATA ++ " -- " ++ lists:reverse(Args),
 {ok, _, Bin} = execute(".", lists:flatten(Cmd)),
 extract(Bin);

stats(Elem) ->
 stats([Elem]).

option(cpu) ->
 "-u";
option(disk) ->
 "-d";
option(sock) ->
 "-n SOCK";
option(eth0) ->
 "-n DEV";
option(eth1) ->
 "-n DEV";
option(eth2) ->
 "-n DEV";
option(proc) ->
 "-c";
option(run) ->
 "-q";
option(mem) ->
 "-r";
option(inode) ->
 "-v";
option(switch) ->
 "-w";
option(swaping) ->
 "-W";
option(_) ->
 error.

execute(_Host, Cmd) ->
 Port = open_port({spawn, Cmd}, [ exit_status, binary ] ),
 wait(Port, []).

wait(Port, Content) ->
 receive 
  {Port, {data, BinData}} ->
   %error_logger:info_msg("dump:~n~p~n", [BinData]),
   NewContent = [ BinData | Content ],
   wait(Port, NewContent);

  {Port, {exit_status, Status}} ->
   %error_logger:info_msg("exit_code: ~p~n", [Status]),
   {ok, Status, Content};

  {Port, eof} ->
   %error_logger:info_msg("Port closed"),
   port_close(Port),
   {ok, eof, Content};

  {Port, exit} ->
   error_logger:info_msg("Received : ~p~n", [Port]),
   Content
 end.

extract(Bin) ->
 sar_values:extract(iolist_to_binary(Bin)).

You can see the "option/1" function that let you convert atoms into command line arguments easily. I use also this function to test if sar is able to handle a specific parameter. For example and with the help of my webservice I can query remote stats easily:

http://monitoring.lan/stats/q/cpu/servername

Here's the "sar_collect" module


-module(sar_collect).

-export([systat/1, sartime/1, start/0, start/1]).
-export([extract/1]).
        spawn(?MODULE, systat, []).

start(Seconds) ->
        spawn(?MODULE, systat, [Seconds]).

% update the file every second        
systat(0) -> 
        loop(1);

systat(Seconds) ->
        loop(Seconds).

%update the file every 59 seconds
systat() ->
        loop(59).

loop(Seconds) when Seconds < 60 ->
 Cmd = lists:flatten([ "sar -o /tmp/last.tmp ", integer_to_list(Seconds),  " 1" ]),
 execute(".", Cmd),
 file:rename("/tmp/last.tmp", "/tmp/last"),
 timer:sleep(60 - Seconds),
 receive
  stop ->
   exit(normal);

  {interval, NewSeconds} ->
   loop(NewSeconds);

  _A ->
   loop(Seconds)

 after 0 ->
  loop(Seconds) 

 end;

%default update 20 seconds (arbitrary chosen)
loop(_Seconds) ->
 loop(20).

execute(Host, Cmd) ->
 Port = open_port({spawn, Cmd}, [ {cd, Host}, exit_status, binary ] ),
 wait(Port, []).

wait(Port, Content) ->
 receive 
  {Port, {data, _BinData}} ->
   wait(Port, Content);

  {Port, {exit_status, _Status}} ->
   ok;

  {Port, eof} ->
   port_close(Port),
   Content;

  {Port, exit} ->
   error_logger:info_msg("Received : ~p~n", [Port]),
   Content
 end.

Finally there is the "sar_values" source code:


-module(sar_values).

-export([extract/1, extractor/1, sort/1]).
-export([parse/1, parse_value/2]).

extract(Bin) ->
 extract(Bin, []).

extract(Bin, Stats) ->
 case parse(Bin) of
  {Class, Type, Rest} ->
   %io:format("~p.~p", [Class, Type]),
   case  parse_value(Rest, <<>>) of
    {more, Value, More} ->
     NewStats = [ {Class, Type, Value} | Stats ],
     extract(More, NewStats);

    {eof, Value} ->
     NewStats = [ {Class, Type, Value} | Stats ],
     NewStats 
   end;

  eof -> 
   Stats 
 end.

parse(<<"%user", Rest/binary >>) -> {cpu, user, Rest};
parse(<<"%nice", Rest/binary>>) -> {cpu, nice, Rest};
parse(<<"%system", Rest/binary>>) -> {cpu, system, Rest};
parse(<<"%iowait", Rest/binary>>) -> {cpu, iowait, Rest};
parse(<<"%steal", Rest/binary>>) ->  {cpu, steal, Rest};
parse(<<"%idle", Rest/binary>>) -> {cpu, idle, Rest};

parse(<<"kbmemfree", Rest/binary>>) -> {mem, kbmemfree, Rest};
parse(<<"kbmemused", Rest/binary>>) -> {mem, kbmemused, Rest};
parse(<<"%memused", Rest/binary>>) -> {mem, memused, Rest};
parse(<<"kbbuffers", Rest/binary>>) -> {mem, kbbuffers, Rest};
parse(<<"kbcached", Rest/binary>>) -> {mem, kbcached, Rest};

parse(<<"kbswpfree", Rest/binary>>) -> {swap, free, Rest};
parse(<<"kbswpused", Rest/binary>>) -> {swap, used, Rest};
parse(<<"%swpused", Rest/binary>>) -> {swap, usage, Rest};
parse(<<"kbswpcad", Rest/binary>>) -> {swap, swpcad, Rest};

parse(<<"dentunusd", Rest/binary>>) -> {inode, dentryunused, Rest};
parse(<<"file-sz", Rest/binary>>) -> {inode, fileopened, Rest};
parse(<<"inode-sz", Rest/binary>>) -> {inode, inodes, Rest};
parse(<<"super-sz", Rest/binary>>) -> {inode, super, Rest};
parse(<<"%super-sz", Rest/binary>>) -> {inode, superusage, Rest};
parse(<<"dquot-sz", Rest/binary>>) -> {inode, dquotsz, Rest};
parse(<<"%dquot-sz", Rest/binary>>) -> {inode, dquotszusage, Rest};
parse(<<"rtsig-sz", Rest/binary>>) -> {rtsig, count , Rest};
parse(<<"%rtsig-sz", Rest/binary>>) -> {rtsig, usage, Rest};

parse(<<"totsck", Rest/binary>>) -> {sock, total, Rest};
parse(<<"tcpsck", Rest/binary>>) -> {sock, tcp, Rest};
parse(<<"udpsck", Rest/binary>>) -> {sock, udp, Rest};
parse(<<"rawsck", Rest/binary>>) -> {sock, raw, Rest};
parse(<<"ip-frag", Rest/binary>>) -> {sock, ipfrag, Rest};

parse(<<"runq-sz", Rest/binary>>) -> {procs, running, Rest};
parse(<<"plist-sz", Rest/binary>>) -> {procs, total, Rest};

parse(<<"ldavg-15", Rest/binary>>) -> {load, min15, Rest};
parse(<<"ldavg-1", Rest/binary>>) -> {load, min1, Rest};
parse(<<"ldavg-5", Rest/binary>>) -> {load, min5, Rest};

parse(<<"pswpin/s", Rest/binary>>) -> {swaping, pswpin, Rest};
parse(<<"pswpout/s", Rest/binary>>) -> {swaping, pswpout, Rest};

parse(<<"l0", Rest/binary>>)   -> parsebis(Rest, l0);
parse(<<"eth0", Rest/binary>>) -> parsebis(Rest, eth0);
parse(<<"eth1", Rest/binary>>) -> parsebis(Rest, eth1);
parse(<<"eth2", Rest/binary>>) -> parsebis(Rest, eth2);

parse(<<>>) -> eof;
 
parse(Bin) ->
 {_, Next} = split_binary(Bin, 1), 
 parse(Next).

parsebis(<<"rxpck/s", Rest/binary>>,  Category) -> {Category, rxpck, Rest};
parsebis(<<"txpck/s", Rest/binary>>,  Category) -> {Category, txpck, Rest};
parsebis(<<"rxbyt/s", Rest/binary>>,  Category) -> {Category, rxbyt, Rest};
parsebis(<<"txbyt/s", Rest/binary>>,  Category) -> {Category, txbyt, Rest};
parsebis(<<"rxcmp/s", Rest/binary>>,  Category) -> {Category, rxcmp, Rest};
parsebis(<<"txcmp/s", Rest/binary>>,  Category) -> {Category, txcmp, Rest};
parsebis(<<"rxmcst/s", Rest/binary>>, Category) -> {Category, rxmcst, Rest};
parsebis(Bin, Category) -> 
 {_, Next} = split_binary(Bin, 1), 
 parsebis(Next, Category).

parse_value(<<$\t, Rest/binary>>, _Value) ->
 parse_value(Rest, _Value);
parse_value(<<$ , Rest/binary>>, _Value) ->
 parse_value(Rest, _Value);

parse_value(<<$\n, _Rest/binary>>, Value) ->
 {more, Value, _Rest};

parse_value(<<>>, Value) ->
 {eof, Value};

parse_value(Bin, Value) ->
 {H, Next} = split_binary(Bin, 1),
 parse_value(Next, iolist_to_binary([Value, H])).

extractor(Motif) ->
 fun(L) when is_list(L) ->
  [ {Y, Z} || {X, Y, Z} <- L, X == Motif]
 end.

sort(List) ->
 lists:sort( fun({X, _V}, {Y, _W}) when X < Y -> 
   true; 
   (_A, _B) -> false 
  end, List).

Now that Erlang is R12B, I'm not so sure if "binary parsing code" is really as efficient as it can...

Parsing Binaries with erlang, lamers inside

2008-06-26T12:03:00.004+02:00

Edit: I don't want to offend anyone with the following, this is just an expression of what i encounter every day with people that do technology but don't know anything. I don't say anyone on the mailling list is a lamer, I say that question like the one evocated here exists because there's too much ignorance in the technology world. And lastly, don't forget this is a personal rant...

It's seems that there's a really high expectation on "parsing binaries" with erlang and reach others languages performance. For me this is a complete nonsense.
What's the meaning of "parsing a binary", a binary is not a text, it's a binary, a sequence of bytes...
A sequence must be defined by its length. You must know before reading anything, the size that'll be needed store what's coming.
Every crap software you can find has always prefered to use strcpy instead of memcpy. Whatever the language you use, you MUST know the size of what you're working with, this is not an advice this is mandatory.

From the post above, you can find that the only delimiter seems to be "\r\n". So if someone sends you 4Gb of data not ending with "\r\n" you'll keep reading it... (and of course blow your memory because this was not supposed to be)

While working at low level with C and flex scanners, I've always ask me this question: "What's the max size of the element I can accept ?". This simple question helps me build software that don't break with a simple 'perl print Ax60000' trick...

So is HTTP badly designed, because delimiters are "\r\n" and headers can spread on multiple lines ? The answer is absolutely YES.
Was'it difficult to build something more secure, using prefixed elements with their size ? The answer is absolutely NO ! (take ajp13 for example...)

Now that erlang is becoming more and more popular, lamers are lurking in the erlang direction. This is life, but will the erlang mailling list suffer from this ? The answer is yes :/

Someone with knowledge must not try to resolve someone's else problem, he must help him by asking the good question. (do you know the size a priori ?)

Why parsing binaries in java is faster than erlang ? Who cares, since parsing binaries is of course stupid !
Parsing real world protocol with erlang is lightning fast, both for writing and for executing. So teach lamers how to build real protocols and don't try help them with some trickery.

That's my rant for today :)

Quick Tip, list join

2008-06-20T09:19:00.000+02:00

Another "lists:join" :


Join = fun([X|Rest], D) -> 
  [ X | [ [D,E] || E <- Rest ] ] 
  end.

Usage:


io:format("~s~n", [Join(["a", "b", "cde", "h", "k", "lm"], $,)]).
a,b,cde,h,k,lm
ok

Ubuntu and Ghostscript

2008-06-18T13:38:00.001+02:00

On my development box, I've recently upgraded my ubuntu. The ghostscript package was also upgraded, but my erlang webservice wasn't able anymore to draw any mobile tag...

I've found that the new ghostscript binary 'gs' has new command line parameters that are incompatible with their previous version...

I used to initialize gs like this:


 Cmd = "gs -sDEVICE=pngalpha -q -dNOPLATFONTS -dNOPAUSE -dGraphicsAlphaBits=2 -sOutputFile=- -",

But that no longer works since this flushing is done only when the process quits...

The correct command line is then:


 Cmd = "gs -sDEVICE=pngalpha -q -dGraphicsAlphaBits=2 -sOutputFile=%stdout -dNOPROMPT",

Everything works fine now, but I've re-read the very long Ghostscript documentation, and the solution comes from this page.

Quick Bash Script for Checking HTTP Headers

2008-06-13T10:09:00.001+02:00

Whenever it comes to efficiently configure Web Servers and setting headers like ETAg, Cache-Control, or Expires and you have more than one server, you need to check them all since any user may hit different servers.

This script is meant to call wget on every IP returned by dig and display http response headers.
Usage is simple:


./script.sh http://www.example.com/ressource/with-long-cache-and-no-etag/big-image.jpg

Here's the code:


#!/bin/bash

BIN=${0##*/}
URL=${1?usage: $BIN url}
HOST=${URL#http://*}
REQ=${HOST#*/}
HOST=${HOST%%/*}

function check
{
	wget -S --header="Host: $HOST" "http://$line/$REQ" -O/dev/null
}

dig +short $HOST | \
while read line
do
	case $line in	
		[a-z]*)
		;;
		[0-9]*.[0-9]*.[0-9]*)
			echo === Testing $HOST with IP $line
			check $line
		;;
		*)
		;;
	esac
done

Monitoring log files with 'tail'

2008-05-19T14:37:00.001+02:00

When you need to look for specific events from logfiles, your first idea is to use 'tail'. Tail is obviously the number one command that any sysadmin knows about.

From the first version of Tail and nowadays, some really nice feature have been implemented, one of those is the "follow=name" feature...

Since your erlang node will stay alive for many days, you'll end up meeting some logrotation tool that will replace the file you're lurking... So "follow=name" is for you !

Extract from a manual page:


     There are two ways to specify how you'd like to track files with
     this option, but that difference is noticeable only when a
     followed file is removed or renamed.  If you'd like to continue to
     track the end of a growing file even after it has been unlinked,
     use `--follow=descriptor'.  This is the default behavior, but it
     is not useful if you're tracking a log file that may be rotated
     (removed or renamed, then reopened).  In that case, use
     `--follow=name' to track the named file by reopening it
     periodically to see if it has been removed and recreated by some
     other program.

Implementing this feature in pure erlang is of course possible, but why loose time when you can directly use the "tail" binary already installed on your system ?


-module(tail).
-export([start/1, start/2, start/3, stop/1, snapshot/1, display/1, init/3]).

start(File) ->
	start(File, fun display/1, "/var/log").

start(File, Callback) ->
	Dir = "/var/log",
	start(File, Callback, Dir).

start(File, Callback, Dir) ->
	spawn_link(?MODULE, init, [File, Callback, Dir]).

snapshot(Pid) ->
	Pid ! {snap, self() },
	receive
		{Port, Callback} ->
			{Port, erlang:fun_info(Callback)};
		_Any ->
			_Any
	end.

stop(Pid) ->
	Pid ! stop.

init(File, Callback, Dir) ->
	Cmd = "/usr/bin/tail --follow=name "++ File,
	Port = open_port({spawn, Cmd}, [ {cd, Dir}, stderr_to_stdout, {line, 256}, exit_status, binary]), 
	tail_loop(Port, Callback).

tail_loop(Port, Callback) ->
	receive
		{Port, {data, {eol, Bin}}} ->
			Callback(Bin),
			tail_loop(Port, Callback);

		{Port, {data, {noeol, Bin}}} ->
			Callback(Bin),
			tail_loop(Port, Callback);

		{Port, {data, Bin}} ->
			Callback(Bin),
			tail_loop(Port, Callback);

		{Port, {exit_status, Status}} ->
			{ok, Status};
			%tail_loop(Port, Callback);
	
		{Port, eof} ->
			port_close(Port),
			{ok, eof};

		{snap, Who} ->
			Who ! { Port, Callback},
			tail_loop(Port, Callback);

		stop ->
			port_close(Port),
			{ok, stop};
		
		_Any ->
			tail_loop(Port, Callback) 
	end.

display(Bin) ->
	Content = iolist_to_binary(Bin),
	io:format("[INFO] ~s~n", [Content]).

Let's say you want to monitor "/var/log/messages", here's how you can do it:


Shell> Tail = tail:start("messages").

This will display every new line (running in background) in your shell session.

Now let's say you want to do some tricky things with every line, you can pass as a parameter a callback fun:


Shell> Pid = logger_new(). % an example
Shell> Callback = fun(X) -> Pid ! {line, X} end. % sending a tuple to Pid
Shell> Tail = tail:start("message", Callback).

Finally, you'll be able to hack the code and transform this method to "tail" multiple files since "tail" is able to watch more than one file...

Quick tip :


init(ListOfFiles, Callback, Dir) ->
	Args = [ [ X, $ ] || X <- ListOfFiles ]
	Cmd = "/usr/bin/tail --follow=name "++ lists:flatten(Args),

Happy Tailing !

Following your directories

2008-05-14T13:47:00.001+02:00

While designing some "integrity checker" tool, I've found myself in trouble whenever I need to
manage directories...

It seems that erlang, for now, is not able to detect "symbolic links" (Unix definition). Opening "kernel/include/file.hrl" holds the truth... The module "filelib" doesn't have any thing related to 'links' neither.

So if you have some links that point to "." you'll observe that "filelib:fold_files" follow the link many times (hopefully its stop somewhere) but you loose some precious time and increase disk accesses...

Then I've rewrote the fold_files to detect links by searching in the path some identical elements:


checktree([]) ->
	true;
checktree([_Elem,_Elem|_Rest]) ->
	false;
checktree([_|Rest]) ->
	checktree(Rest).

This is not really high quality but seems to work as expected...

I've also added some "maxdeep" functionality that prevent the script to go too many deeper.

I've named this module "wfile" for no particular reason :) and here's the full code:


-module(wfile).
-export([list/1, list/2]).

list(Dir) ->
	Fun = fun(X, _Acc) -> io:format("+ ~s~n", [X]) end,
	list(Dir, Fun).

list(Dir, Fun) ->
	fold_files(Dir, Fun, []).

fold_files(Dir, Fun, Acc) ->
	fold_files(Dir, true, Fun, Acc).

fold_files(Dir, Recursive, Fun, Acc) ->
	fold_files1(Dir, Recursive, Fun, Acc).

fold_files1(Dir, Recursive, Fun, Acc) ->
	case file:list_dir(Dir) of
		{ok, Files} -> fold_files2(Files, Dir, Recursive, Fun, Acc);
		{error, _}  -> Acc
	end.

fold_files2([], _Dir, _Recursive, _Fun, Acc) -> 
	Acc;
fold_files2([File|T], Dir, Recursive, Fun, Acc0) ->
	FullName = filename:join(Dir, File),
	case filelib:is_regular(FullName) of
		true  -> 
			Acc = Fun(FullName, Acc0),
			fold_files2(T, Dir, Recursive, Fun, Acc);

		false ->
			case Recursive and filelib:is_dir(FullName) and maxdeep(FullName, 6) of
				true ->
					Acc1 = fold_files1(FullName, Recursive, Fun, Acc0),
					fold_files2(T, Dir, Recursive, Fun, Acc1);
				false ->
					fold_files2(T, Dir, Recursive, Fun, Acc0)
		end
    end.

maxdeep(Filename, Max) ->
	Elems = filename:split(Filename),
	( Max > length(Elems) ) and checktree(Elems).

checktree([]) ->
	true;
checktree([_Elem,_Elem|_Rest]) ->
	false;
checktree([_|Rest]) ->
	checktree(Rest).

To end to story, here's how I used this module:


erl> IC = integrity_checker:start().
erl> wfile:list("/home/rolphin/tmp", fun(X, Acc) -> IC ! {add, X}, io:format("added: ~s~n", [X]) end).

EasyErl goes Mobile Friendly

2008-05-08T10:13:00.002+02:00

Hi, I'm experiencing Mobile Tagging.
You can see it at the left side of this page.
Tags are generated dynamically, I'm using of course Erlang, Mochiweb, Ghostscript (rendering backend) and iec16022 to build the semacode.

Since I own a Nokia N95, I can efficiently scan my own codes, but I don't know if it's the case for everyone :)

So leave me a comment if you find those code hard to read...
Thanks

Directories Recursively and Simple Binary Matching

2008-03-09T17:18:00.004+01:00

Hi, It has been a long time :)

So today two simple things first, some high order fun to work on tree:


-module(dir).
-export([create/1]).

create(List) ->
        H = fun(X) ->
                fun(Y) ->
                        Dir = filename:join([X,Y]),
                        io:format("mkdir(~s)~n", [Dir]),
                        Dir
                        end
                end,
        build(fun(X) -> X end, H,  List).

build(_Fun, _Builder, []) ->
        ok;
build(Fun, Builder, [Elem|List]) ->
        NewFun = Builder(Fun(Elem)),
        build(NewFun, Builder, List).

A sample session:


5> dir:create(["ab","cd", "ef","12", "35", "av"]).
mkdir(ab/cd)
mkdir(ab/cd/ef)
mkdir(ab/cd/ef/12)
mkdir(ab/cd/ef/12/35)
mkdir(ab/cd/ef/12/35/av)
ok

What's interesting is the Builder fun that construct the fun that will be called the next time.
That way we know were we are in the tree... The last Fun has all the knowledge of its ancestors :)

Now a simple binary matcher code, I need it while extracting values from regex results. It takes a list of offsets and returns what's inside:


slice(Slices, Bin) ->
       slice(Slices, [], Bin).

slice([], Acc, _Bin) ->
       lists:reverse(Acc);
slice([ {Start, Stop} | Rest ], Acc, Bin) ->
       Len = Stop - Start,
       <<_:Start/binary,Value:Len/binary,_/binary>> = Bin,
       slice(Rest, [ Value | Acc ], Bin).

A sample session:


8> matcher:slice([{1,5},{8,10}], <<"this is a not a solution">>).
[<<"his ">>,<<"a ">>]

I hope that someone will find this valuable...

Server DNS problems, and no longer available downloads :/

2007-12-20T09:55:00.002+01:00

My own box has some troubles with its DNS entries, this means that you can no longer reach the LibTre (treregex-0.7)...

I've set up an googlepage to store it in the mean time: easyerl.googlepages.com.

Why did I take some much time to fix it ? That's because I've left Paris to work in the South of France, exactly "sur la côté d'Azur".

I'll publish some other simple things in the near future... So you just need to subscribe to my Feed :).

Download libTre.

PS: Now if you read the mailing list you'll be able to retrieve the package...

NAGIOS (beurk) nrpe support for erlang

2007-11-19T21:53:00.000+01:00

NAGIOS a pretty bad software uses a pretty bad protocol, but NAGIOS seems to be installed everywhere...
I needed a way to bypass its really poor scheduling process, and naturally erlang comes to my rescue... But everything is not so simple.

NRPE this horrible protocols uses fixed length packets (from the code the 2 last characters are never sets to 0, sizeof seems to be really misunderstood by the nagios developer :p).

But NRPE is another crap CRC32 code, and for efficiency and time saving I didn't wanted to reimplemented it in Erlang, so I wrote a nrpe_crc32 port...

Here's the crc32 code:



#include <unistd.h>
#include <stdio.h>
#include <string.h>

static unsigned long crc32_table[256];

typedef struct packet_struct
{
 int16_t   packet_version;
 int16_t   packet_type;
 u_int32_t crc32_value;
 int16_t   result_code;
 char      buffer[MAX_PACKETBUFFER_LENGTH];
} packet;

/* build the crc table - must be called before calculating the crc value */
void generate_crc32_table(void){
 unsigned long crc, poly;
 int i, j;

 poly=0xEDB88320L;
 for(i=0;i<256;i++){
  crc=i;
  for(j=8;j>0;j--){
   if(crc & 1)
    crc=(crc>>1)^poly;
   else
    crc>>=1;
  }
  crc32_table[i]=crc;
 }

 return;
}

/* calculates the CRC 32 value for a buffer */
unsigned long calculate_crc32(char *buffer, unsigned int buffer_size){
 register unsigned long crc;
 int this_char;
 int current_index;

 crc=0xFFFFFFFF;

 for(current_index=0;current_index  this_char=(int)buffer[current_index];
  crc=((crc>>8) & 0x00FFFFFF) ^ crc32_table[(crc ^ this_char) & 0xFF];
 }

 return (crc ^ 0xFFFFFFFF);
}

unsigned long test(const char *value)
{
 return calculate_crc32((char *) value, strlen(value));
}

The port_driver:


/* port_driver.c */

#include "erl_driver.h"

extern void generate_crc32_table(void);
extern unsigned long calculate_crc32(char *, unsigned int);

typedef struct {
 ErlDrvPort port;
} crc32_data;

static ErlDrvData crc32_drv_start(ErlDrvPort port, char *buff)
{
 crc32_data* d = (crc32_data*)driver_alloc(sizeof(crc32_data));
 d->port = port;

 /* init crc32 table */
 generate_crc32_table();
 return (ErlDrvData) d;
}

static void crc32_drv_stop(ErlDrvData handle)
{
 driver_free((char*)handle);
}

static void crc32_drv_output(ErlDrvData handle, char *buff, int bufflen)
{
 crc32_data* d = (crc32_data*)handle;

 char fn = buff[0];
 char *arg = &buff[1];
 unsigned long res;

 switch (fn) {
  case 1:
   res = calculate_crc32(arg, bufflen - 1);
   driver_output(d->port, (char *) &res, (sizeof(unsigned long)));
   break;
  default:
   break;
 }
}

ErlDrvEntry crc32_driver_entry = {
 NULL,                       /* F_PTR init, N/A */
 crc32_drv_start,          /* L_PTR start, called when port is opened */
 crc32_drv_stop,           /* F_PTR stop, called when port is closed */
 crc32_drv_output,         /* F_PTR output, called when erlang has sent */
 NULL,                       /* F_PTR ready_input, called when input descriptor ready */
 NULL,                       /* F_PTR ready_output, called when output descriptor ready */
 "crc32_drv",              /* char *driver_name, the argument to open_port */
 NULL,                       /* F_PTR finish, called when unloaded */
 NULL,                       /* F_PTR control, port_command callback */
 NULL,                       /* F_PTR timeout, reserved */
 NULL                        /* F_PTR outputv, reserved */
};

DRIVER_INIT(crc32_drv) /* must match name in driver_entry */
{
 return &crc32_driver_entry;
}

The crc32 module, initializing the lib, and calling the crc32 fun:



-module(crc32).

-export([start/0,init/1,compute/1]).

start() ->
 start("crc32_drv").

start(SharedLib) ->
 case erl_ddll:load_driver(".", SharedLib) of
  ok -> ok;
  {error, already_loaded} -> ok;
  _E ->  io:format("Error: ~p~n", [_E]),
   exit({error, could_not_load_driver})
 end,
 spawn(?MODULE, init, [SharedLib]).

init(SharedLib) ->
 register(?MODULE, self()),
 Port = open_port({spawn, SharedLib}, [binary]),
 loop(Port).


compute(X) ->
 Bin = iolist_to_binary(X),
 call_port(<<1, Bin/binary>>).

call_port(Msg) ->
 ?MODULE ! {call, self(), Msg},
 receive
  {?MODULE, Result} ->
   Result
 end.

loop(Port) ->
 receive
  {call, Caller, Msg} ->
   Port ! {self(), {command, Msg}},
   receive
    {Port, {data, Data}} ->
     Caller ! {?MODULE, decode(Data)}
   end,
   loop(Port);

  stop ->
   Port ! {self(), close},
   receive
    {Port, closed} ->
     exit(normal)
   end;

  {'EXIT', Port, Reason} ->
   io:format("~p ~n", [Reason]),
   exit(port_terminated)
 end.

% Also, Valid for Network 
decode(<<U:32/big-unsigned>> = Bin) when is_binary(Bin) ->
 U.

decode(X) -> X.

Now the nrpe module, there you'll see why the nrpe is pure crap, fixed packet length for this type of tool is nonsense...



-module(nrpe).

-export([encode/1, request/1, crc32/1, connect/1, connect/2]).


encode(Bin) ->
 { Crc, _} = crc32:compute(Bin),
 <<Crc:32, Bin>>.

request(Query) ->
 Version = 2,
 Type = 1,
 Crc = 0,
 Code = 0,
 Blank = <<0:32/unit:256>>, % 1024 bytes 
 Q = iolist_to_binary(Query),
 Padlen = 1024 - size(Q),
 {C, _} = crc32:compute(
 <<Version:16, Type:16, Crc:32, Code:16, Q/binary, 0, 0, Blank:Padlen/binary>>),
 <<Version:16, Type:16, C:32, Code:16, Q/binary, 0, 0, Blank:Padlen/binary>>.

Building two binaries to only send one, is completely dump. But this is required... Thanks
to nrpe...



crc32(Bin) ->
 {Crc, _} = crc32:compute(Bin),
 {Crc, Bin}.

%
% send_packet.packet_version=(int16_t)htons(NRPE_PACKET_VERSION_2);
% send_packet.packet_type=(int16_t)htons(QUERY_PACKET);
% strncpy(&send_packet.buffer[0],query,MAX_PACKETBUFFER_LENGTH);
% send_packet.buffer[MAX_PACKETBUFFER_LENGTH-1]='\x0';
% 
% send_packet.crc32_value=(u_int32_t)0L;
% calculated_crc32=calculate_crc32((char *)&send_packet,sizeof(send_packet));
% send_packet.crc32_value=(u_int32_t)htonl(calculated_crc32);

%% #define QUERY_PACKET  1  /* id code for a packet containing a query */
%% #define RESPONSE_PACKET  2  /* id code for a packet containing a response */
%% 
%% #define NRPE_PACKET_VERSION_2   2               /* packet version identifier */
%% #define NRPE_PACKET_VERSION_1 1  /* older packet version identifiers (no longer supported) */
%% 
%% #define MAX_PACKETBUFFER_LENGTH 1024  /* max amount of data we'll send in one query/response */

%% typedef struct packet_struct{
%%  int16_t   packet_version;
%%  int16_t   packet_type;
%%  u_int32_t crc32_value;
%%  int16_t   result_code;
%%  char      buffer[MAX_PACKETBUFFER_LENGTH];
%%         }packet;

connect(Host) ->
 connect(Host, 5666). 

connect(Host, Port) ->
 case gen_tcp:connect(Host, Port, [binary, {active, false}]) of
  {ok, Sock} ->
   Query = request("test"),
   send(Sock, Query),
   io:format("Response: '~s'~n", [recv(Sock)]), 
   close(Sock);

  {error, Error} ->
   io:format("Connect-error: ~p~n", [Error])
 end.

send(Sock, Data) ->
 case gen_tcp:send(Sock, Data) of
  ok ->
   ok;

  {error, Error} ->
   io:format("send-error: ~p~n", [Error])
 end.

recv(Sock) ->
 case gen_tcp:recv(Sock, 0, 2000) of
  {ok, Packet} ->
   io:format("read: ~p~n", [Packet]),
   decode(Packet);

  {error, Error} ->
   io:format("recv-error: ~p~n", [Error])
 end.
  
  
close(Sock) ->
 gen_tcp:close(Sock).


decode(<<Version:16, Type:16, Crc:32, 0, 0, Rest/binary>>) ->
 io:format("Version: ~p, Type: ~p, Crc: ~p~n", [Version, Type, Crc]),
 decode_response(Rest).

decode_response(Bin) ->
 Len = msg_len(Bin, 0),
 {Msg, _} = split_binary(Bin, Len),
 Msg.
 

msg_len(<<0, Rest/binary>>, Len) ->
 Len;
msg_len(Bin, Len) ->
 {_, Next} = split_binary(Bin, 1),
 msg_len(Next, Len + 1).

I hope someone will find this interesting :p

Treregex-0.7 download now

2007-11-18T22:33:00.000+01:00

You can download the treregex-0.7 from here.

To test it you need to install the libtre library, normally you can do this by using apt-get:


-apt-cache search libtre
libtre-dev - development package for the libtre4 regexp matching library
libtre4 - regexp matching library with approximate matching

Install the libtre4 and libtre-dev, and then try to ./configure the treregex. You may need to edit Makefile adjusting path for your needs...

And as usual, feedback is welcome :p

Digraph and your network, too easy

2007-11-18T21:43:00.000+01:00

The digraph module can help you build directed graph (or not directed) very easily. I need to know the status of all my hosts within my network, and I make statistics about service availability.
With the digraph module I am able to write links between my hosts, my hosts are: karoten, ultraten, muloten, arsen, masculen, colen, pollen.
So I define them at the first time


(beta@karoten)425> f(D), D = digraph:new(). % a new digraph
{graph,22,23,24,true}
(beta@karoten)426> servers:add(D, [karoten,ultraten,muloten,arsen,masculen,colen,pollen]). 
ok

Now I can manipulate my nodes (my servers)


(beta@karoten)427> servers:connect(D, karoten, [ultraten,{muloten,http}, arsen, {masculen,ssh}]).
ok

karoten can reach ultraten, and muloten with http, arsen, and masculen with ssh.


(beta@karoten)428> servers:connect(D, colen, [{muloten,http}, arsen, {pollen,ssh}]).             
ok

colen can reach muloten with http, arsen, and pollen with ssh.

So let's find colen links:


(beta@karoten)429> servers:links(D, colen).
[{colen,muloten,http},{colen,arsen,[]},{colen,pollen,ssh}]

This exactly what I've written before, good ...

And muloten links:


(beta@karoten)430> servers:links(D, muloten).
[{karoten,muloten,http},{colen,muloten,http}]

This is deduced from what I've describe before...

Now let's imagine we want to find a way to reach one node from another:


(beta@karoten)431> digraph:get_path(D, karoten, arsen).
[karoten,arsen]

Karoten seems to be connected with arsen.

Let's create a new link, between ultraten and colen:


(beta@karoten)434> servers:connect(D, ultraten, colen). 
['$e'|7]

Let's try to reach pollen from karoten:


(beta@karoten)435> digraph:get_path(D, karoten, pollen).
[karoten,ultraten,colen,pollen]

So the way is: thru ultraten, colen, karoten can reach pollen...

Now let's design a more web design approach, with a firewall, a load balancer lb, and various httpd and application servers, finally databases:


(beta@karoten)436> servers:add(D, [firewall,lb,http1,http2,http3,app1,app2,app3,app4,db1,db2]).
ok

The firewall is directly connected to the load balancer:


(beta@karoten)437> servers:connect(D, firewall, lb).
ok

The load balancer distribute the load to three httpd:


(beta@karoten)438> servers:connect(D, lb, [http1,http2,http3]).
ok
(beta@karoten)439> servers:connect(D, http1, [app1,app2,app3]).
ok
(beta@karoten)440> servers:connect(D, http2, [app2,app3]).
ok
(beta@karoten)441> servers:connect(D, http3, [app3]).
ok
(beta@karoten)442> servers:connect(D, app3,[db1,db2]).
ok
(beta@karoten)443> servers:connect(D, app2, [db1]).
ok
(beta@karoten)444> servers:connect(D, app1, db2).
['$e'|21]

Finally I can find a path between the firewall and the database 2:


(beta@karoten)445> digraph:get_path(D, firewall, db2).
[firewall,lb,http3,app3,db2]

Now the code:


module(servers).

-export([add/2,del/2,connect/3,links/2,reachable/2]).

add(Graph, Servers) when list(Servers) ->
 lists:foreach(fun(X) -> digraph:add_vertex(Graph, X) end, Servers);

add(Graph, Server) ->
 digraph:add_vertex(Graph, Server).

del(Graph, Servers) when list(Servers) ->
 lists:foreach(fun(X) -> digraph:del_vertex(Graph, X) end, Servers);

del(Graph, Server) ->
 digraph:del_vertex(Graph, Server).

connect(_Graph, _Server, []) ->
 ok;
connect(Graph, Server, [ {S, L} | Servers ]) ->
 digraph:add_edge(Graph, Server, S, L),
 connect(Graph, Server, Servers);
connect(Graph, Server, [ S | Servers ]) ->
 digraph:add_edge(Graph, Server, S),
 connect(Graph, Server, Servers);
 
% connect(Graph, Server, Servers) when list(Servers) ->
%   lists:foreach(fun(X) -> digraph:add_edge(Graph, Server, X) end, Servers);

connect(Graph, Server, S) ->
 digraph:add_edge(Graph, Server, S).

links(Graph, Server) ->
 lists:map(fun(X) -> {_, S1, S2, Label} = digraph:edge(Graph, X), {S1, S2, Label} end, digraph:edges(Graph, Server)).

reachable(Graph, Server) when list(Server) ->
 digraph_utils:reachable(Server, Graph);
reachable(Graph, Server) ->
 digraph_utils:reachable([Server], Graph).

Experimenting with the erlang SSH support, or remote 'tail' with SSH...

2007-11-17T16:54:00.000+01:00

While designing my monitoring tool, and working and treregex, I found the ssh documentation and realize that it can be very useful for my tool.

A simple question needed to be answered, is the ssh module able to easily spawn a remote process for me ?
To verify, I tried to build a remote tail module called ssh_tail :)


-module(ssh_tail).
        
-export([tail/3]).
-define(TIMEOUT, 5000). 

tail(Host, User, Pass) ->
 case ssh_cm:connect(Host, 22, [{user_dir, "/var/tmp/ssh"}, {user, User}, {password, Pass}]) of
  {ok, CM} ->
   session(CM, fun(X) -> io:format("-ssh: ~p~n", [X]) end);

  Error ->
   Error
 end.

From the ssh documentation user_dir let you decide where you want to store keys, from my experience it's better to use a separate directory from the ~/.ssh.
It happens that latest version of ssh add meta information to their files that the ssh module can't handle. (more on this in another post).

For the test I wanted to do a "tail -f" on a specific file ie "/var/log/syslog".


session(CM, Callback) ->
 case ssh_cm:session_open(CM, ?TIMEOUT) of
  {ok, Channel} ->
   case ssh_cm:shell(CM, Channel) of 
    ok ->
     ssh_cm:send(CM, Channel, "tail --follow=name /var/log/syslog\n"),
     ssh_loop(CM, Channel, Callback);

    Error ->
     error_logger:error_msg("Error: ~p~n", [Error])
   end;
  Error ->
   error_logger:error_msg("Session Error: ~p~n", [Error])
 end.

ssh_cm is responsible for starting a shell, and sending commands to the remote shell process. I send


tail --follow=name /var/log/syslog\n

Don't forget the final '\n' character, since you won't get any results if you don't send it :p
(I didn't think of that while testing for the first time and think that the code didn't work at all...)


ssh_loop(CM, Channel, Callback) ->
 receive
  stop ->
   % Closing channel
   % ssh_cm:detach(CM, ?TIMEOUT),
   ssh_cm:close(CM, Channel);

  {ssh_cm, CM, {data, _Channel, 0, Data}} ->
   Callback(Data), 
   ssh_loop(CM, Channel, Callback);

  {ssh_cm, CM, {data, Channel, Type, Data}} ->
   io:format("extended (~p): ~p~n", [Type, Data]),
   ssh_loop(CM, Channel, Callback);

  {ssh_cm, CM, {closed, _Channel}} ->
   ssh_cm:detach(CM, ?TIMEOUT);
   
  E ->
   error_logger:info_msg("[~p] Received: ~p~n", [?MODULE, E]),
   ssh_loop(CM, Channel, Callback) 
 end.

ssh_cm sends various message to the calling process, more important tuples are


{ssh_cm, CM, {data, _Channel, 0, Data}}

Data holds what you want, and in our case a line sent by the tail process...
The callback defined at the beginning is then executed:


tail(Host, User, Pass) ->
 case ssh_cm:connect(Host, 22, [{user_dir, "/var/tmp/ssh"}, {user, User}, {password, Pass}]) of
  {ok, CM} ->
   session(CM, 
    fun(X) ->  % Our Callback 
     io:format("-ssh: ~p~n", [X]) % simple display...
    end);

  Error ->
   Error
 end.

To conclude this simple module is able to spawn a remote "tail -f" using a ssh connection and using a callback function on every data received.

The code was designed from the ssh_ssh module that you can find in the ssh module source code, because the ssh documentation is really sparse for now...

An gen_server for mass regexp computing... (LibTre)

2007-11-15T15:47:00.000+01:00

This is the first test session of my 'tregex_srv' that provides some nice regexp features:


266> l(tregex_srv).                                                 
{module,tregex_srv}
267> tregex_srv:start_link().                                       
{ok,<0.4045.0>}
268> tregex_srv:store( [<<"[0-9+] pid">>, <<"[a-z]+.tmp">>]).       
ok
269> tregex_srv:grep(<<"test 9405904.tmp acuu.tmpmulaor 10+ pid">>).
[[[{34,39,<<"+ pid">>}],[{17,25,<<"acuu.tmp">>}]]]
270> tregex_srv:store( [{ <<"test">>, fun(X) -> io:format("found: ~p~n", [X]) end},  <<"[0-9][0-9]">>]).
ok
271> tregex_srv:grep(<<"test 9405904.tmp acuu.tmpmulaor 10+ pid">>).                                    
found: [{0,4,<<"test">>}]
[[[{34,39,<<"+ pid">>}],[{17,25,<<"acuu.tmp">>}]],
 [[{0,4,<<"test">>}],[{5,7,<<"94">>}]]]
272> tregex_srv:store( [{ <<"SRC=[^ ]+">>, fun(X) -> 
 [{_,_,M}] = X, io:format("Source: ~p~n", [M]) 
end}]).                   
ok
273> tregex_srv:grep(<<"test 9405904.tmp acuu.tmpmulaor 10+ pid">>).                                      
found: [{0,4,<<"test">>}]
[[[{34,39,<<"+ pid">>}],[{17,25,<<"acuu.tmp">>}]],
 [[{0,4,<<"test">>}],[{5,7,<<"94">>}]],
 []]
274> tregex_srv:grep(<<"tst SRC=192.135.15.1 pid">>).               
Source: <<"SRC=192.135.15.1">>
[[[{19,24,<<"1 pid">>}]],
 [[{8,10,<<"19">>}]],
 [[{4,20,<<"SRC=192.135.15.1">>}]]]
275> tregex_srv:store( [{ <<"SRC=([^ ]+)">>, fun(X) -> 
 [{_,_,_}, {_,_,M}] = X, io:format("Source IP: ~p~n", [M]) 
 end}]).
ok
276> tregex_srv:grep(<<"tst SRC=192.135.15.1 pid">>).                                                                   
Source IP: <<"192.135.15.1">>
Source: <<"SRC=192.135.15.1">>
[[[{19,24,<<"1 pid">>}]],
 [[{8,10,<<"19">>}]],
 [[{4,20,<<"SRC=192.135.15.1">>}]],
 [[{4,20,<<"SRC=192.135.15.1">>},{8,20,<<"192.135.15.1">>}]]]

As you can see, you can associate Funs with regexp Matches. This means that you can bind action to regexp...
First we store (in fact add regexp to the existing regexp list) new tuples {RE, Fun}:


275> tregex_srv:store( [{ <<"SRC=([^ ]+)">>, fun(X) -> 
 [{_,_,_}, {_,_,M}] = X, io:format("Source IP: ~p~n", [M]) 
 end}]).
ok

Now the exec does call already registered funs, but call the new one since our regexp matches and you can see that the IP number is only printed, the "submatches" feature works as expected:


276> tregex_srv:grep(<<"tst SRC=192.135.15.1 pid">>).                                                                   
Source IP: <<"192.135.15.1">>
Source: <<"SRC=192.135.15.1">>
...

The gen_server state is the following:


-record(state, {
                requests,
                reindex,
                re = [],
                pids = []
                }).

Its init function is:


init(_Args) ->
        process_flag(trap_exit, true),
        {ok, #state{  
 re = ets:new(?MODULE, [set,private]), 
 requests = 0, 
 reindex = 1 }}.

Internally the module calls 'treregex:compile' to compile regexp and store the resulting #port into a list that is stored in the 'ets' table. Every call to 'tregex_srv:store' create a new entry in the ets table.


%% Storing RE and Funs
%% Creating simple fun when there's none provided...
%%
store([], Res, State) ->
        ets:insert(State#state.re, { State#state.reindex, Res});
store([ { Regexp, Fun } | List ], Res, State) ->
        {ok, Re } = treregex:compile(iolist_to_binary(Regexp), [extended]),
        store(List, [ { Re, Fun } | Res ], State);
store([ Regexp | List ], Res, State) ->
        {ok, Re } = treregex:compile(iolist_to_binary(Regexp), [extended]),
        store(List, [ { Re, fun(_) -> false end} | Res ], State).

The 'tregex_srv:grep' just uses 'ets:foldl' to compute results:


handle_call({grep, Line}, _Node, State) ->
        Requests = State#state.requests,
        Grep = fun({_Reindex, ReList}, Acc) ->
                        [ exec(ReList, Line, []) | Acc]
                end,
        {reply, ets:foldl(Grep, [], State#state.re), State#state{ requests = Requests + 1} }.

%% exec, using a List of {Re, Funs}
exec([], _Line, Acc) ->
        Acc;
exec([ { Re, Fun } | ReList ], Line, Acc) ->
        case treregex:exec(Re, Line) of
                {ok, Matches} ->
                        Fun(Matches),
                        exec(ReList, Line, [ Matches | Acc ]);

                {error, nomatch} ->
                        exec(ReList, Line, Acc)
        end;
exec([ _Any | ReList ], Line, Acc) ->
        exec(ReList, Line, Acc).

The code is still young, but seems to work.

The main purpose here, is to be able to massively process lines of logs. I want to be able to
spawn multiple process on multiples nodes that will be able to extract valuable content from
various lines. This is the first step forward :-)

I may cleanup the 'grep' fun since it will returns empty list whenever a regexp didn't match anything from the supplied line...

I'm really excited to think that I will be able to use the 'gen_server:multi_call' with this module :)

LibTRE returning matching values

2007-10-22T12:55:00.000+02:00

New version of libTRE driver, now exec returns also matching binaries:


Erlang (BEAM) emulator version 5.5.5 [source] [async-threads:0] [hipe] [kernel-poll:false]

Eshell V5.5.5  (abort with ^G)
1> erl_ddll:load_driver(code:priv_dir(treregex)++"/bin", "TRE_drv").
ok
2> {ok, RE} = treregex:compile(<<"([a-z]+)([0-9]+)">>, [extended]).
{ok,#Port<0.79>}
3> treregex:exec(RE, <<"this is a test9234 of blast">>). 
{ok,[{10,18,<<"test9234">>},{10,14,<<"test">>},{14,18,<<"9234">>}]}
4> 
4>  treregex:exec(RE, <<"this is arolpghin39235 test9234 of blast">>). 
{ok,[{8,22,<<"arolpghin39235">>},{8,17,<<"arolpghin">>},{17,22,<<"39235">>}]}
5>

Soon to be released !

LibTRE in Action, the approximative match

2007-10-17T11:43:00.000+02:00

Here's a sample session showing some of the libTre features:


Erlang (BEAM) emulator version 5.5.5 [source] [async-threads:0] [hipe] [kernel-poll:false]

Eshell V5.5.5  (abort with ^G)
1> erl_ddll:load_driver(code:priv_dir(treregex)++"/bin", "TRE_drv").
ok
2> f(RE),  {ok, RE} =  treregex:compile(<<"fear">>, [extended]).
{ok,#Port<0.74>}
3> treregex:approx(RE, <<"fir">>, 0, []).
{error,nomatch}
4> treregex:approx(RE, <<"fir">>, 1, []).
{error,nomatch}
5> treregex:approx(RE, <<"fir">>, 2, []).
{ok,[{0,3}]}
6> treregex:approx(RE, <<"fir">>, 1, []).
{error,nomatch}
7> treregex:exec(RE, <<"fir">>).         
{error,nomatch}
8> treregex:free(RE).
ok
9> f(RE),  {ok, RE} =  treregex:compile(<<"loubov">>, [extended]).
{ok,#Port<0.76>}
10>  treregex:approx(RE, <<"love">>, 3, []).
{ok,[{0,3}]}
11>  treregex:approx(RE, <<"to love">>, 0, []). 
{error,nomatch}
12>  treregex:approx(RE, <<"to love">>, 1, []).
{error,nomatch}
13>  treregex:approx(RE, <<"to love">>, 2, []).
{error,nomatch}
14>  treregex:approx(RE, <<"to love">>, 3, []).
{ok,[{0,6}]}
15>  treregex:approx(RE, <<"aimer">>, 3, []).  
{error,nomatch}
16>  treregex:approx(RE, <<"aimour">>, 3, []).
{error,nomatch}
17>  treregex:approx(RE, <<"amour">>, 3, []). 
{error,nomatch}
18>  treregex:approx(RE, <<"amour">>, 10, []).
{ok,[{1,6}]}

LibTRE, I finally got it working !

2007-10-17T08:32:00.000+02:00

Hi !
I'm please to say that I finally managed the 'TRE_drv.c' code to work as expected. This time there's no more 'segfault'. The solution is to use only non conflicting function names:

regncomp and not regcomp
regnexec and not regexec
tree_free and not regfree

Since every posix Regex function will be used instead of their Tre equivalent, I was forced do find a special case for 'regfree'. There's no special regX function for 'regfree'.
Because regfree can be called at many places, when an erlang error occurs, or simply when we quit the shell; the function is trying to free the posix regex_t with a pointer to a TRE regex_t, so the crash is always there.
While looking at 'tre-internal.h' I've found the 'tre_free' function that will do the real job of freeing the TRE regex_t... So I've just declared as 'extern' this function directly into the TRE_drv.c file...

extern void tree_free(regex_t *preg);
static void tre_stop(ErlDrvData drv_data)
{
    struct driver *d = (struct driver*) drv_data;

//    if (d->compiled)
//      regfree(&(d->re));

        if (d->compiled)
                tre_free(&d->re);

    driver_free(d);
}

This time I've also added a call to the 'reganexec' function that's able to find approximate matches. The code is of course located into the 'tre_from_erlang' function. (this function gets called whenever erlang talks to the driver).


... snip ...
                case APPROX: 
                        
                        /* <> */

                        flags = get_int32(buf + 4);
                        cost = get_int32(buf + 8);

                        memset(&amatches, 0, sizeof(amatches));
                        amatches.pmatch = matches;
                        amatches.nmatch = MAX_MATCHES;

                        regaparams_default(®aparams);
                        regaparams.max_cost = cost;


                        status = reganexec(&d->re, buf + 12,  len - 12, &amatches, regaparams,  flags);
                        if (status != 0) {
                                driver_send_status(d, status);
                                return;
                        }

                        driver_send_matches(d, matches, MAX_MATCHES);
                        break;
... snip ...

With this you're able to make things like this:


{ok, RE} = treregex:compile(<<"test">>, [extended]).
treregex:approx(RE, <<"this is a tast">>, 0, []).

the 'fun approx/4' has the 'cost' (an integer) as extra argument, this correspond to the cost of manipulation characters to find a match. You'll find more about this here.


Approximate pattern matching allows matches to be approximate, that is, allows the matches to be 
close to the searched pattern under some measure of closeness. TRE uses the edit-distance measure
 (also known as the Levenshtein distance) where characters can be inserted, deleted, or 
substituted in the searched text in order to get an exact match. Each insertion, deletion, or 
substitution adds the distance, or cost, of the match. TRE can report the matches which have a 
cost lower than some given threshold value. TRE can also be used to search for matches with the 
lowest cost.

Finally, now that the driver and the erlang module works well I'll upload it to various repositories...

LibTre and Posix, the segfault explanation

2007-10-13T19:54:00.000+02:00

You already know that I want to make a libTRE driver such as the RE posix driver... But what you may not know is that I've never lost this amount of time debugging things...
I've, for a long long time ago, called 'gdb' my friend to rescue me ...
Let me explain the problem: we want to call 'regcomp' and 'regexec' from the libTRE package. Take your time and reread this sentence:


We want to call 'regcomp' and 'regexec' from the libTRE package.

This seems really easy, but we want to make this from a shared library... A shared library that we will open at runtime.
And lauching our erlang shell make the ld process finds symbols addresses in various .so files for us automagically...

Since I'm using ubuntu, the posix regexp are located in the libc.so.6 library, so ld knows about regcomp and regexec before I can even call 'erl_ddll:load_driver/2'...

Loading the driver into the erlang vm from my freshly built .so file, don't really work as expected... 'regcomp' is still the one from the glibc, and not the one from the libTRE driver...

But 'regex_t' is the one from tre, and 'regcomp' is the one from posix... There definition of the regex_t struct isn't the same :p

The driver structure:


typedef struct _desc {
    ErlDrvPort     port;
    ErlDrvTermData dport;          /* the port identifier as ErlDrvTermData */
    regex_t re;
    regmatch_t pm[16];
    int compiled;
} Desc;

Now the 'sizeof(regex_t)' from Tre is 8 and the posix is a lot more ... So when I call the 'regcomp' function like this:


        switch(op) {
                case COMPILE: 
... snip ...
                        status = regcomp(&d->re, buf+8, flags);
                        d->compiled = 1;
... snip ...

The 'regmatch_t' is exactly overflowed by exactly

( sizeof (posix regex_t) - (2 * sizeof (tre regex_t)) )

bytes ...

This is the reason why I get a segfault (from my last post) when I try to call 'regexec'...

I'm now rewriting a simpler interface to libtre that will not have names that can collide with posix...

LibTre for Fast regular expression

2007-10-10T12:19:00.001+02:00

While reading the almost famous article about regular expressions, I tried to use TRE.
Since TRE is posix Compliant, but unfortunately don't have any erlang driver I downloaded ''posregex'' and hack it a little to make it use TRE.

Now here's some experiment with it:


22> Init = fun() ->  erl_ddll:load_driver(code:priv_dir(treregex)++"/bin", "TRE_drv") end.
#Fun
23> Init().
ok
24> f(List), List = treutils:build([<<"test">>, <<"toto">>, <<"[a-z][0-9]$">>, <<"^[a-zA-Z][a-zA-Z0-9_]+">>]).
[{<<"test">>,#Port<0.84>},
{<<"toto">>,#Port<0.85>},
{<<"[a-z][0-9]$">>,#Port<0.86>},
{<<"^[a-zA-Z][a-zA-Z0-9_]+">>,#Port<0.87>}]

25> treutils:exec(List, <<"alkjlskdjflskjglksjflakgjlkfgjl;dkgjklsdjglkdsjfglksd
jlkgjsdlkfgjlsdk fg989t9sgdkgj lkyrdy sjd gyrdsl;gkj test asl;dksdf">>).
{<<"alkjlskdjflskjglksjflakgjlkfgjl;dkgjklsdjglkdsjfglksdjlkgjsdlkfgjlsdk 
fg989t9sgdkgj lkyrdy sjd gyrdsl;gkj test a"...>>,

[{ok,<<"^[a-zA-Z][a-zA-Z0-9_]+">>},{ok,<<"test">>}]}

26> treutils:exec(List, <<"10alkjlskdjflskjglksjflakgjlkfgjl;dkgjklsdjglkdsjfglksdjlkgjsdlkfgjlsdk 
fg989t9sgdkgj lkyrdy sjd gyrdsl;gkj test asl;dksdf">>).                   
{<<"10alkjlskdjflskjglksjflakgjlkfgjl;dkgjklsdjglkdsjfglksdjlkgjsdlkfgjlsdk 
fg989t9sgdkgj lkyrdy sjd gyrdsl;gkj test"...>>,

[{ok,<<"test">>}]}

I build a List of Port that are compiled regular expressions, then I iterate thru the list matching "Line".

Here's the TreUtils module (BTW, you can replace treregex with posregex if you want...)


-module(treutils).
-export([build/1, exec/2, destroy/1]).

build(List) ->
       Fun = fun(X) ->
               {ok, RE} = treregex:compile(X, [extended]),
               {X, RE}
       end,
       lists:map(Fun, List).

destroy(List) ->
       lists:foreach( fun({_Name, RE}) -> treregex:free(RE) end, List).

exec(List, Line) ->
       exec(List, Line, []).

exec([], Line, Acc) ->
       {Line, Acc};
exec([H|Rest], Line, Acc) ->
       {Name, RE} = H,
       case treregex:match(RE, Line) of
               ok ->
                       exec(Rest, Line, [ {ok, Name} | Acc ]);

               {error, nomatch} ->
                       exec(Rest, Line, Acc)
       end.

Other libraries are also available.

Unfortunately I'm unable to make this module rock solid since it segfault if I ever call the 'exec' method two times... I think that there's a problem in the TRV_drv.c (heavily copied from the RE_drv.c) in the 'RE_from_erlang' function. The regexec call may garbage some of its internal...


typedef struct _desc {
    ErlDrvPort     port;
    ErlDrvTermData dport;          /* the port identifier as ErlDrvTermData */
    regex_t re;
    regmatch_t pm[16];
    int compiled;
} Desc;

... snip ...

static void RE_from_erlang(ErlDrvData drv_data, char *buf, int len)
{
        int status;
        unsigned int op = get_int32(buf);
        unsigned int flags = get_int32(buf+4);
        Desc *d = (Desc*) drv_data;

        switch(op) {

... snip ...

                case EXEC: 
                        status = regexec(&d->re, buf+8, (size_t) 16, &d->pm[0], flags);
                        if (status != 0) {
                                driver_send_status(d, status);
                                return;
                        }
                        driver_send_pm(d);
                        break;

I hope I'll come back soon with good news, since this TRE library looks very very promising...
If anyone have any clue ;p, please comment !

High Order Functions must be tested before use

2007-10-02T08:55:00.000+02:00

From my previous article comments it is a small and efficient method of filtering datas:


Cpu = fun({cpu, _, _}) -> true; (_) false end.

But whenever we want to transposing it into a HOF (high order function):


Filter = fun(Elem) ->
 fun({Elem, _, _}) -> true; (_) false end
 end.

This naive approach doesn't work:


1> Filter = fun(Elem) -> fun({Elem, _, _}) -> true; (_) -> false end end. 
#Fun<erl_eval.6.49591080>
2> C = Filter(cpu).
#Fun<erl_eval.6.49591080>
3> C({test, t, t}).
true % this should have been false ...

As explained in this document, we need to use guards to make our high order function effective:


The rules for importing variables into a fun has the consequence that certain pattern matching 
operations have to be moved into guard expressions and cannot be written in the head of the fun.

The correct way is:


Filter = fun(Elem) ->
 fun({X, _, _}) when X == Elem -> true; (_) false end
 end.

So we must keep in mind that sometimes we should really check that our HOF is working as expected !

High Order Functions, filtering lists...

2007-10-01T09:49:00.000+02:00

I have a list of collected cpu and network values, from eth0 and eth1:

 L =
[{cpu,user,<<"3.05">>},
 {cpu,nice,<<"0.00">>},
 {cpu,system,<<"0.72">>},
 {cpu,iowait,<<"0.03">>},
 {cpu,steal,<<"0.00">>},
 {cpu,idle,<<"96.20">>},
 {eth0,rxpck,<<"2.52">>},
 {eth0,txpck,<<"0.15">>},
 {eth0,rxbyt,<<"173.80">>},
 {eth0,txbyt,<<"44.68">>},
 {eth0,rxcmp,<<"0.00">>},
 {eth0,txcmp,<<"0.00">>},
 {eth0,rxmcst,<<"1.25">>},
 {eth1,rxpck,<<"0.00">>},
 {eth1,txpck,<<"0.02">>},
 {eth1,rxbyt,<<"0.00">>},
 {eth1,txbyt,<<"1.00">>},
 {eth1,rxcmp,<<"0.00">>},
 {eth1,txcmp,<<"0.00">>},
 {eth1,rxmcst,<<"0.00">>}]

If I want to manipulate such data set I'll need some filter functions that will help me to extract values, I need cpu values and eth0 values. High order function can do that for me !

First we need to select tuples, 'cpu' tuples:


Cpu = fun({X, Y, Z}) -> 
 if X == cpu -> 
  true; 
 true ->
  false 
 end 
end.

A better and far more erlangish method (thanks Zvi):


Cpu = fun({cpu,_,_}) -> true;
         (_) -> false
end.

Okay this fun will return true whenever the first element of the tuple is 'cpu'.
But this fun is static, since 'cpu' is written in the function body. Let's make it dynamic:


Filter = fun(Motif) ->
  fun({X, Y, Z}) ->
   if X == Motif ->
    true;
   true ->
    false 
   end
  end 
 end.

The new High order function 'Filter' is generated by 'fun(Motif)' and takes as argument a tuple '{X, Y, Z}', this is a fun that return a fun...
This function can be used like this:


List = {cpu, test, dummy}. % a sample list
Cpu = Filter(cpu). % generate the Cpu fun
Cpu(List). %executing the Cpu fun
true.
List2 = {test, cpu, dummy}. %Other dummy list
Cpu(List2).
false.

Come back to our initial data set, and realize that we must iterate thru the list to extract possible values. Iterate and apply a fun to every element is what we need to do, futhermore we need to retrieve matching values... In fact we need to build the list of extracted values, and this can be accomplished by 'lists:foldl':


extractor(Motif) ->
 fun(L) -> 
  lists:foldl(
   fun({X, Y, Z}, List) -> 
    if X == Motif 
     -> [ {Y,Z} | List ]; 
     true -> List 
    end 
   end, 
   [], L) 
 end.

In details, 'List' is the accumulator list, the one that will grow with valid tuple, the one we will return. The fun is the same as described before. To make things clear 'extractor/1' returns a fun that will parse a list of tuple extracting values that matches 'Motif'.

Another easier method, using only list comprehension:


extractor(Motif) ->
        fun(L) when is_list(L) ->
                [ {Y, Z} || {X, Y, Z} <- L, X == Motif]
        end.

Usage:


38> Cpu = module:extractor(cpu).
#Fun<module.1.131615259>
39> Cpu(L).
[{idle,<<"96.20">>},
 {steal,<<"0.00">>},
 {iowait,<<"0.03">>},
 {system,<<"0.72">>},
 {nice,<<"0.00">>},
 {user,<<"3.05">>}]
40> Eth0 = module:extractor(eth0).
41> Eth0(L).
[{rxmcst,<<"1.25">>},
 {txcmp,<<"0.00">>},
 {rxcmp,<<"0.00">>},
 {txbyt,<<"44.68">>},
 {rxbyt,<<"173.80">>},
 {txpck,<<"0.15">>},
 {rxpck,<<"2.52">>}]

I use such code for my monitoring project, I use the sar output (sysstat package), and I graph using rrdtool... This is a part of a bigger project that will compose a 'scheduler'.

Building Things with high order functions...

2007-09-29T17:02:00.000+02:00

One thing that always surprise me, is code that extensively uses high order function or let's call that "functions that returns functions" (may be known also as "closure")...
What can I, myself, do with such things ?
After a little time reading and thinking, and reading and reading, I designed a really simple usage of all of this. I'll create some helper functions to build xml tags...


-module(tags).
-export([tags/1]).

tags(Elem) ->
       fun(X) ->
               "<" ++ Elem ++ ">" ++ X ++ "</" ++ Elem ++ ">"
       end.

Let me explain:

Elem will be the enclosing tag
X is the parameter the function will receive at call time

The module in action:


1> c(tags).
{ok,tags}
2> Div = tags:tags("div").
#Fun<tags.0.28130594>
3> Div("html text").
"<div>html text</div>"
4>

'tags:tags' returns a function that will create div tags...

Now you're able to build a list of functions that will create valid output, without knowing the real syntax. You can see 'tags:tags' as a function that abstract the final notation of an element of your choice.

For example, building a 'title' tags is done by :


Title = tags:tags("title").

Building a list of functions for your language can be done like this:


lists:map(fun tags:tags/1, ["title", "div", "p", "ul", "li", "script"]).

Erlang LDAP support and Active Directory

2007-09-11T09:53:00.000+02:00

Where I work now, LDAP and Active Directory are used everywhere, since this is a nice idea and everybody is used to it, I have the obligation to use the same framework for users authentication...
Once there's a central authentication mecanism somewhere it would be idiotic to not use it :p

This is why I started looking the Erlang LDAP support...

Everybody knows that erlang is really good at doing ASN1, but more people may not know that this feature is very very powerful... And while using the LDAP protocol this is really a killer feature, because once all ELDAP.* generated files are written you have access to the full power of LDAPv3...

I was idling a little on #erlang and talked a bit about LDAP and finally 'etnt' shows me the 'eldap' module... The first article I found was the one on Trapexit.org.
Since I use CEAN to work I just need to do


cean:install(eldap).

To get the 'eldap' module installed, I also use the developer cean package so I can retrieve source files aka *.erl files...

Then comes problems...
I wasn't able to connect to any of both servers. I was able to see that the tcp connection was correct but that the module don't want to bind (LDAP meaning).

I then activate the debug level (really nice feature):


eldap:debug_level("ldap", 2).

After that everything becomes clearer... The 'check_Pkt/1' fun incorrectly drop the packet !
I modified the fun, and make it returns 'ok'. Right after that every connection (bind) attempt worked flawlessly...

Another thing I need to do was searching DN from a DN attributes, this cannot be done by anything else than a 'distinguishedNameMatch' only available with an 'ExtensibleMatch':

Performing ExtensibleMatch (LDAPv3):
We need to add this line into the 'v_filter/1' fun:


v_filter({extensibleMatch, AV}) -> {extensibleMatch, AV};

The rest is fully handled by the ASN1 part...

Making an ExtensibleMatch part 2:


Base = "dc=example,dc=com".
Filter = {extensibleMatch, {'MatchingRuleAssertion',"2.5.13.1", "CN", "Username", false}}
eldap:search("ldap", [ Base, Filter ]).

While this query perfectly works with OpenLdap it doesn't with Active Directory !
In fact AD closes the connection directly... (May be a bug ?)

Erlang Picasa API, it works, and here's some reason why...

2007-08-15T00:37:00.000+02:00

The Post request to the picasa web service:


request_picasa(AuthToken, User, ImgName, Data) ->
     Body = iolist_to_binary(Data),
     Authorization = <<"GoogleLogin auth=", AuthToken/binary>>,
     Url = "http://picasaweb.google.com/data/feed/api/user/" ++ User ++ "/album/blog",
     case http:request(post,
                     {       Url,
                             [ { "Authorization", binary_to_list(Authorization) },
                               { "Slug", ImgName }
                             ],
                             "image/jpeg",                           % Content-type
                             Body                                    % Body
                     },
             [ {timeout, 30000}, {sync, false} ],            % HTTPOptions
             [ {body_format, binary} ]) of                   % Options

             {ok, Result} ->
                     case Result of
                             {{_, 201, _}, Headers, Response} ->
                                     {ok, Headers, Response};

                             {_,_,Response} ->
                                     Response
                     end;

             {error, Reason} ->
                     io:format("Error: ~p~n", [Reason])
     end.

And what's you must note is the following:

a new url to Post your image.
a new header named 'Slug' holding the value of the filename you want for your image
a timeout of 30 seconds, letting enough time for the upload process to complete.

Other headers are mandatory, and hopefully already set by 'http:request':

content-length holding the size of the binary data of your image
content-type holding the image type, here 'image/jpeg'

I choose to use the 'prim_file:load_file/1' fun to retrieve a binary stream of octet composing the image I want to upload:


      {ok, File} = prim_file:read_file(Image),
      {value, {_, Auth}} = lists:keysearch(picasa, 1, State#state.auth),
      case request_picasa(Auth, User, ImgName, File ) of

The variable File holds the binary data, the Auth variable holds the 'correct' Picasa AuthToken, so the 'request_picasa/4' fun can be called correctly...

I'll upgrade later the project http://code.google.com/p/googerl, because I want the 'request_picasa' fun to return {ok, ImageUrl}, and to do that I need to parse the atom response sent by Google... And I'm asking myself wether I doit using xmerl or leex ;]

Picasa API for erlang, within the googerl project...

2007-08-14T00:32:00.000+02:00

I'm working on the Picasa module for googerl, and was unable to get something else than:


Token Invalid

While scouting my network traffic to really see what I sent:


POST /data/feed/api/user/XXXXXXX/album/blog HTTP/1.1.
content-type: image/jpeg.
content-length: 24425.
te: .
host: picasaweb.google.com.
authorization: GoogleLogin auth=DQAAAIAAAAA5xws0PFfzZEzJ9JsboXhEtKXCdV06ZobagrB61zPWy9lU4j9dOQEK247yR8aQMS83mr3AmPPjkGLTnk3aGUjWsaYmUjmyw20gWrgrZUMcLijbRJUyg5J_t1x45qbglqn7Z07NtIHXudh8GpmnWkTE9T-sghc7AokEiDMzOFmGRg.
connection: keep-alive.
slug: test-v.jpg.
.
......JFIF.....H.H......Exif..MM.*.....................

I realize that my post was correct !
So why this error ?

The answer is in the Picasa Documentation, and it's hard to find but here it is:

Include the relevant parameters in the body of the POST request, as described in the ClientLogin documentation. Use lh2 as the service name.

(extracted from http://code.google.com/apis/picasaweb/gdata.html#Add_Album_Manual_Installed)
I must retrieve a token for the 'lh2' service ! The one I've sent was for the 'blogger' service.

So there's a problem with my current implementation, since my 'google.erl' module is only storing one AuthToken... I'll have to fix this, I'll use a list of AuthToken tuple:


[ {picasa, "authtoken"}, {blogger, "authtoken"} ]

So the code will be heavily modified, and for the time being doesn't work anymore :p
I'll come back soon with good news for everyone !

Managing lists of binaries or strings...

2007-08-11T17:40:00.000+02:00

When you want to deal with binaries, the preserve speed and 'normal' memory footprint there's one fun that you must be aware !

This is 'iolist_to_binary' and it's brother 'iolist_size'.

With theses you can do whatever you need to manager large array of strings, or manage small strings or small binaries... In fact you can do everything.

From my blogger module I need a fun to give me back only binary stuff, for example this fun that just returns a valid 'div' element:


test(Title) ->
       [ <<"<div class='title'>">>, iolist_to_binary(Title), <<"</div">> ].

With the 'iolist_to_binary' fun I don't have to deal with guards... ie: I don't need to call 'list_to_binary' if the argument is a list...
Here's some tests:


35> blogger_utils:test("blah"). %this is a string
[<<'"<div class='title'>">>,<<"blah">>,<<"</div">>]

36> blogger_utils:test(<<"blah">>). %this is a binary
[<<"<div class='title'>">>,<<"blah">>,<<"</div">>]

37> blogger_utils:test([<<"blah">>, "bli"]). %this is a list of mixed types
[<<"<div class='title'>">>,<<"blahbli">>,<<"</div">>]

Convenient isn't it ?

Blogger_srv.erl version 0.1 is here !

2007-08-07T22:11:00.000+02:00

Here's the link to find the 'blogger_srv' you're waiting for: blogger_srv.erl.

This is the first version of the code, I think I'll add other features later:

auto reauth whenever the authtoken gets invalid
add some support for posting binary data, like images..
replace those antislashed double quotes by simple quotes ;)

For the time now, the code works, and all you need to do is starting the server:

blogger_srv:init().

Call the 'auth' fun to obtain a valid 'AuthToken':

blogger_srv:auth("youremail@gmail.com", "yourpass").

Finally call the 'new/4' or 'new/5' fun to post a message:

blogger_srv:new(yourBlogId, Title, [Tags], <<Content>>).
blogger_srv:new(yourBlogId, Title, [Tags], <<Content>>, AuthorName, AuthorEmail).

When the post is successfull, 'new/4' or 'new/5' will returns:

{ok, NewPostId}

That's all for now !

Blogger gen_server, a running session

2007-08-07T14:30:00.001+02:00

Here's a screenshots of a sample session using 'blogger_srv'.
You can see some of available funs 'auth', 'snap' and others...

Here's the link of the google project.

Blogger API gen_server !

2007-08-06T22:04:00.000+02:00

I'm proud to announce the start of the Blogger API gen_server !

I'll use the code I already wrote for testing the blogger API, and put some OTP requirement around it... For the moment there's three gen_server call:

new: to create a new post
reset: to reset credentials, i.e. retrieve another AuthToken
auth: to retrieve the AuthToken (recomputing it if needed)

Extracted from the 'blogger_srv.erl' file:


auth(Username, Password) ->
 gen_server:call(?MODULE, {auth, Username, Password}).

new(BlogId, Title, Tags, Content, {AuthorName, AuthorEmail} ) ->
 gen_server:call(?MODULE, {post, BlogId, Title, Tags, Content, AuthorName, AuthorEmail}).

reset() ->
 gen_server:cast(?MODULE, reset).

For example, the 'post' fun:


handle_call({post, BlogId, Title, Tags, Content, {AuthorName, AuthorEmail}}, _Node, State) ->
 Requests = State#state.requests,
 Auth = State#state.auth,
 Data = entry_new(Title, {AuthorName, AuthorEmail}, Content, Tags),
 case request(Auth, BlogId, Data) of 
  {ok, PostId} ->
   {reply, {ok, PostId}, State#state{ requests = Requests + 1 } };

  Msg ->
   {reply, {err, Msg}, State#state{ requests = Requests + 1 } }
 end;

The final request the post your Atom message.

2007-08-06T21:54:00.000+02:00

The final request to post the message in the atom format:


request(AuthToken, BlogId, Data) ->
        Body = iolist_to_binary(Data),
        io:format("Sending: ~nContent-length: ~p~nBody:~n~s~n", [ size(Body), Body ]),
        Authorization = "GoogleLogin auth=" ++ AuthToken,
        Url = "http://www.blogger.com/feeds/" ++ BlogId ++ "/posts/default",
        case http:request(post,                                         % Method ;)
                        {
                                Url,                                    % URL
                                [ { "Authorization", Authorization } ], % Headers
                                "application/atom+xml; charset=utf-8",  % Content-type
                                Body                                    % Body
                        },
                [ {timeout, 3000}, {sync, false} ],             % HTTPOptions
                [ {body_format, binary} ]) of                   % Options

                {ok, Result} ->
                        case Result of
                                {{_, 201, _}, Headers, _Response} ->
                                        PostId = get_postid(Headers),
                                        {ok, PostId};

                                {_,_,Response} ->
                                        Response
                        end;

                {error, Reason} ->
                        io:format("Error: ~p~n", [Reason])
        end.

The thing that's cool overthere is the 'get_postid/1' to retrieve the postId generated by the blogger api... This fun will be called only when the HTTP 'status' code will be "201", which means "created".

I parse response headers and search for 'location' string, and once found I extract the last part of the url:


get_postid([]) ->
 "none";
get_postid(Headers) ->
 case lists:keysearch("location", 1, Headers) of
  {value, {_, Value}} ->
   lists:last( string:tokens(Value, "/") );

  _ ->
   "none"
 end.

I've look at the Zend Framework, and found that it parse the entire response body to extract the same value... I think that my method is simpler and works better. That's also why erlang is for smarter people than php (gratuitous troll :p)

More things about the blogger API...

2007-08-06T21:44:00.000+02:00

I've reworked many times the atom template I use to post things to blogger, and what I'll describe here is a design I found simple and efficient, so here's the code :

This is the main function:


entry_new(Title, Author, { Content, ContentType }, Tags) when is_list(Tags) ->
        NTitle = post_title(Title),
        NContent = post_content(Content, ContentType),
        NTags = post_tags(Tags),
        NAuthor = post_author(Author),
        [
                entry_header(),
                NTitle,
                NContent,
                NAuthor,
                NTags,
                entry_footer()
        ];

The main idea is to use a list of binary, using this simple methods we don't mess with multiple copies or padding or strings management... This is quick and clean.

Here's some little function to create simple tempates:


entry_new(Title, Author, Content, Tags) ->
        entry_new(Title, Author, {Content, text}, Tags).

entry_header() ->
        <<"<entry xmlns=\"http://www.w3.org/2005/Atom\">">>.

entry_footer() ->
        <<"</entry>">>.
        
post_title(Title) ->
        [ <<"<title type=\"text\">">>, list_to_binary(Title), <<"</title>">> ].

post_author({ AuthorName, AuthorEmail }) ->
        [ 
        <<"<author><name>">>, list_to_binary(AuthorName), <<"</name><email>">>,
        list_to_binary(AuthorEmail), <<"</email></author>">> ];
post_author(AuthorEmail) ->
        post_author({ "", AuthorEmail }).

Here's some other function to carefully set the content-type with the post content:


post_content(Content, ContentType) when is_list(Content) ->
        post_content(list_to_binary(Content), ContentType);
post_content(Content, html) ->
        post_content(Content, "html");
post_content(Content, xhtml) ->
        post_content(Content, "xhtml");
post_content(Content, text) ->
        post_content(Content, "text");
post_content(Content, ContentType) ->
        [ <<"<content type=\"">>, list_to_binary(ContentType), <<"\">">>,
        Content,
        <<"</content>">> ].

And now the code the post 'tags':


post_tags([]) ->
        <<>>;
post_tags(List) ->
        lists:map(
                fun(X) ->
                        [ <<"<category scheme='http://www.blogger.com/atom/ns#' term='">>,
                        list_to_binary(X) ,
                        <<"'/>">> ]
                end,
                List).

The magic stands in the 'category' atom tag.

Blogger API, posting a message (with tags)

2007-08-02T14:58:00.000+02:00

Here's some code from the current version:


Data = entry_new("Test no1", {"tonio", "ako@gmail.com"}, <<"TestContent">>, ["erlang", "test"]),
request(Auth, iolist_to_binary(Data)).

The Title,
The author, a tuple with authorName and authorEmail
A binary holding the content of the post
A list of tags

I think I'm on the right track...
More news later...

Erlang Blogger API is working !!!

2007-08-02T10:54:00.000+02:00

I've finally manage to get it working !
The solution was in the AuthToken from my code, I didn't squeezed the final '\n' character !

Later when the http request was generated, headers were split, making the GFE returning 400 Bad Request.

This is the corrected 'extract_auth/1':


extract_auth(<<"Auth=", Rest/binary>>) ->
        Size = size(Rest) - 1,
        <<Auth:Size/binary, _/binary>> = Rest,
        {ok, Auth};

I squeeze the final character !

Here's a link to the google groups discussion.

Blogger API, xml sample

2007-08-01T22:01:00.000+02:00

Here's the XML code is used as test:


simple_post(AuthToken) ->
 Data = 
<<"<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"yes\"?>
<entry xmlns=\"http://www.w3.org/2005/Atom\">
<title type=\"text\">UberKwl</title>
<content type=\"xhtml\">
<div xmlns=\"http://www.w3.org/1999/xhtml\">
       <p>test post</p>
</div>
</content>
<author> <name> Gautier </name> <email> gauth@gmail.com </email>
</author>
</entry>">>,
 request(AuthToken, Data).

Really, really simple, and this was extracted from a previous post somewhere in the google Blogger API groups...

I've 'xmllint'ed it and of course it was correct...

Connecting Erlang to Blogger (Part 2) - Adding an entry

2007-07-31T21:49:00.000+02:00

For this second part, we start where we left the last time.
We were able to read the response of a succesful login, data was three lines of key value pairs.
The last line holds the final 'AuthToken' we need to send to the blogger atom post service...

So here's the code to extract the line that begins with the 'Auth' keyword and store the value after the '=' and before the end of line:


extract_auth(<<>>) ->
 {error, not_found};
extract_auth(<<"Error=", Rest/binary>>) ->
 Size = size(Rest) - 1,
 <<Msg:Size/binary, _/binary>> = Rest,
 {error, binary_to_list(Msg)};

extract_auth(<<"Auth=", Rest/binary>>) ->
 {ok, Rest};
extract_auth(<<_:1/binary, Rest/binary>>) ->
 extract_auth(Rest).

Note that we are also able to read 'Error' lines, those lines are sent in case of an failed login attempt...
I can describe what 'extract_auth/1' do like this:

if binary in empty returns {error, not_found}
if binary begins with 'Error' catch it and returns its content with the tuple {error, Msg}
if binary begins with the 'Auth' keyword extract everything till the end of the binary
in any other case extract one character and parse the rest of the binary

To conclude, upon successful login this fun will return:


{ok, "AAAAAQAARAFA..."}

This is, of course our Blogger AuthToken...

Now how can we use it ? This is Simple !
Open a new file named blogger.erl and write something like this:


-module(blogger).
-export([ new/3, post/3, test/2, template/3 ]).

post(AuthToken, Title, Content) ->
 Data = template(Title, Content),
 request(AuthToken, iolist_to_binary(Data)).

template(Title, Content) when is_list(Content) ->
 template(Title, Content, {"none", "none"}). 

template(Title, Content, Author) when is_list(Content) ->
 template(Title, list_to_binary(Content), Author);

template(Title, Content, Author) ->
 {AuthorName, AuthorEmail} = Author,
 [ <<"<entry xmlns=\"http://www.w3.org/2005/Atom\">\n<title type=\"text\">\n">>, 
 list_to_binary(Title), 
% <<"</title><content type='xhtml'><div xmlns='http://www.w3.org/1999/xhtml'>">>, 
 <<"</title>\n<content type=\"text\">">>, 
 Content, 
 <<"</content>\n<author><name>">>,
 list_to_binary(AuthorName),
 <<"</name>">>,
 list_to_binary(AuthorEmail),
 <<"<</author>\n</entry>\n">> ].

request(AuthToken, Data) when is_binary(AuthToken) ->
 request(binary_to_list(AuthToken), Data);

request(AuthToken, Data) ->
 io:format("Sending: ~nContent-length: ~p~nBody:~n~s~n", [ size(Data), Data ]),
 Authorization = "GoogleLogin auth=" ++ AuthToken,
 Url = "http://www.blogger.com/feeds/199963XXXX081936700/posts/default", % Put your BlogID, this one is invalid
 case http:request(post,  
  { Url, 
   [ { "Authorization", Authorization } ], 
   "application/atom+xml; charset=utf-8", Data}, 
  [ {timeout, 3000}, {sync, false} ], 
  [ {body_format, binary} ]) of 

  {ok, Result} -> 
   %io:format("Received: ~p~n", [Result]),
   {_,_,Body} = Result,
   Body;
 
  {error, Reason} ->
   io:format("Error: ~p~n", [Reason])
 end.

Once you're done, you'll be pleased to found that this doesn't work :/.
Yep, I wasn't able to post anything !
May be I've missed something in the documentation, but all I get is an nice SAXexception...

Testing my Erlang Blogger API ...

2007-07-31T16:30:00.000+02:00

I'm stuck on this error message !


<<"org.xml.sax.SAXParseException: Content is not allowed in prolog.">>

I'm simply using this code:


request(AuthToken, Data) ->
        io:format("Sending: ~nContent-length: ~p~nBody:~n~s~n", [ size(Data), Data ]),
        Authorization = "GoogleLogin auth=" ++ AuthToken,
        Url = "http://www.blogger.com/feeds/19996386XX081936700/posts/default",
        case http:request(post,
                { Url,
                        [ { "Authorization", Authorization } ],
                        "application/atom+xml; charset=utf-8", Data},
                [ {timeout, 3000}, {sync, false} ],
                [ {body_format, binary} ]) of

                {ok, Result} ->
                        %io:format("Received: ~p~n", [Result]),
                        {_,_,Body} = Result,
                        Body;

                {error, Reason} ->
                        io:format("Error: ~p~n", [Reason])
        end.

And the resulting Body is always the error:


<<"org.xml.sax.SAXParseException: Content is not allowed in prolog.">>

Help Meeee !

Connecting Erlang to Blogger (Part 1) - Auth with ClientLogin

2007-07-30T19:58:00.000+02:00

With the Gdata API from google you can connect your application to some nice services... Calendar, Blogger etc.
Since this is completly REST based you can of course use your 'http:request' to connect and exploit those services. Let's begin with the ClientLogin process.

For this article we will focus on the Blogger API, the main purpose is of course create an Erlang client for Blogger :)

Connecting to google is as simple as sending something like this:


accountType=HOSTED_OR_GOOGLE&Email=YOURGOOGLEACOUNT&Passwd=YOURPASSWORD&source=SelfCo-TestApp-1&service=blogger

Now we can do it in Erlang too !. First we need to build the query string, second we need to send it to the ClientLogin service using 'http:request'.


auth(Username, Password, Application) ->
    Sep = <<"&">>,
    Post = [
            <<"accountType=HOSTED_OR_GOOGLE&">>,
            <<"Email=">>, list_to_binary(Username), Sep,
            <<"Passwd=">>, list_to_binary(Password), Sep,
            <<"source=">>, list_to_binary(Application), Sep,
            <<"service=blogger">> ],
    request(erlang:iolist_to_binary(Post)).

The fun 'erlang:iolist_to_binary/1' transforms the list of binaries to a simple binary, this is not really necessary but this will ease yourself later for debugging...

Now we can send this query string to the google ClientLogin process:


request(Data) ->
      case http:request(post,
          {"https://www.google.com/accounts/ClientLogin", [],
           "application/x-www-form-urlencoded", Data},
          [ {timeout, 3000} ], [{stream, "/tmp/google.test"}, {body_format, binary}]) of

              {ok, saved_to_file}  ->
                      io:format("Saved to file~n");

              {ok, Result} ->
                      io:format("Received: ~p~n", [Result]);

              {error, Reason} ->
                      io:format("Error: ~p~n", [Reason])
      end.

This is a POST query
The service is https://www.google.com/accounts/ClientLogin
The content-type is application/x-www-form-urlencoded
We sets the timeout to 3 seconds
We store the result (if successful to '/tmp/google.test')

Let's try this code:


65> google:auth("test@gmail.com", "secretcode").
Received: {{"HTTP/1.1",403,"Forbidden"},
           [{"cache-control","no-cache"},
            {"date","Sun, 29 Jul 2007 20:44:20 GMT"},
            {"pragma","no-cache"},
            {"server","GFE/1.3"},
            {"content-length","24"},
            {"content-type","text/plain"}],
           <<"Error=BadAuthentication\n">>}
ok

The connection fails, so let's try with a valid user account:


70> google:auth("validaccount@gmail.com", "validpassword").
Saved to file
ok

Success !

The content of '/tmp/google.test':


SID=DQAAAG8AAACuATb7YJxMdqQhp0LIf546SWLfDNfTlANffRc0B6OGbTat4Ebdj89s6hVEzfNZRL...
LSID=DQAAAHEAAAAG1iqBgOrgzrY5cdgpBv9y42HxkvjNuUaYKImw6yH7xh0GtL5EG19C9GkGdPEb1...
Auth=DQAAAHAAAAAG1iqBgOrgzrY5cdgpBv9y42HxkvjNuUaYKImw6yH7xh0GtL5EG19C9GkGdPEb1...

The final token we need is the 'Auth=' one, this string will be passed with every new query as an 'Authorization' header:


Authorization: GoogleLogin auth=DQAAAHAAAA...

Next Time in Part 2, I'll show you how we'll use this AuthToken and how we will be able to post a message to our blog !

Erlang and JBOSS, talking AJP13 ! (PART I)

2007-07-24T22:08:00.000+02:00


-module(ajp13).
-export([get/3, cping/2, request/1, hexdump/1]).

Every ajp packets starts with 0x1234. In Erlang when you need to express this thing you just need to use the notation 'Base#number'.
So for our example, here's the 'ajp_header' fun :

   
ajp_header() ->
        <<16#12, 16#34>>.

We use the binary notation to write 2 bytes expressed on base 16 (hexadecimal). To be crystal clear hex notation can be written with '16#'... :


Eshell V5.5.1  (abort with ^G)
1> 16#deadbeef. 
3735928559

I'm sure you get the point !

Let's comes back to our AJP problem... Now that we can write hexadecimal number we can reread the ajp13 protocol description,
and succesfully start to build a simple packet:


get(Host, Port, Url) -> 
        H = ajp_header(), 
        Request = request(Url),
        Length = size(Request), 
        Data = <<H/binary, Length:16, Request/binary>>,
        
        case gen_tcp:connect(Host, Port, [binary, {packet, 0}]) of
                {ok, Socket} ->
                        send(Socket, Data),
                        loop(Socket);

                {error, Msg} ->
                        io:format("error: ~p~n", [Msg])
        end.

Let's look at a simple command in the ajp13 protocol, the 'ping', here's its implementation:

                                   
cping() ->
        <<                
        10:8                            
        >>.

cping(Host, Port) ->
        H = ajp_header(),
        Request = cping(),
        Length = size(Request),
        Data = <<H/binary, Length:16, Request/binary>>,

        case gen_tcp:connect(Host, Port, [binary, {packet, 0}]) of
                {ok, Socket} ->
                        send(Socket, Data),
                        loop(Socket);

                {error, Msg} ->
                        io:format("error: ~p~n", [Msg])
        end.

What's important to see is also that ajp13 is derived from the xdr protocol, where every type is always written with its length... In ajp13 this length is always encoded as two bytes (16bits so max size is 16#ffff ;)

The 'Data' variable is what you should look at :


        Data = <<H/binary, Length:16, Request/binary>>,

H is the ajp header
Length is the length of Request written on 2 bytes (2 * 8)
Request is the request

Now that we've sent the packet, we need to catch the response, so here's the 'loop' fun:


loop(Socket) ->
        receive
                {tcp, Socket, Data} ->
                        % io:format("~p~n", [Data]),

                        case ajp_response(Data, Socket) of
                                {ok, continue} ->
                                        loop(Socket);

                                {ok, body, Bin} ->
                                        io:format("Body: read ~p bytes~n", [size(Bin)]),
                                        loop(Socket);

                                {ok, closed} ->
                                        gen_tcp:close(Socket)
                        end;

                {tcp_error, Socket, Error} ->
                        io:format("Error: ~p~n", [Error]),
                        loop(Socket);

                {tcp_closed, Socket} ->
                        io:format("Closed~n")

        after 8000 ->
                io:format("Timeout~n"),
                gen_tcp:close(Socket)

        end.

Whenever our erlang process will receive a message matching the '{tcp, Socket, Data}' tuple we will parse the 'Data' with the 'ajp_response' fun:


ajp_response(<<65,66,0,2,5,1>>, _Socket) ->
        {ok, closed};
ajp_response(<<65,66,Rest/binary>>, Socket) ->
        ajp_data_length(Rest, Socket);
ajp_response(Bin, Socket) ->
        {ok, body, Bin}.

Yeah ! Polymorphism ! Or matching power ?! Whatever, this completely rox the programming planet !
We are simply matching binary data... Binary data that's sent back to us from the jboss server (in our case).

Ajp13 protocol describes the termination of the request by a packet containing 'AB' followed by the response length '2' bytes which are '5' and '1'.


ajp_response(<<65,66,0,2,5,1>>, _Socket) ->
        {ok, closed};

Remember Length is encoded on two bytes: '0,2'...

Now comes the AJP13_FORWARD_REQUEST !!!


request(Request) ->
        {Protocol, L0} = ajp_string("HTTP/1.1"),
        {Request_uri, L1} = ajp_string(Request),
        {Remote_addr, L2} = ajp_string("127.0.0.1"),
        {Remote_host, L3} = ajp_string("ajbchecker"),
        {Server_name, L4} = ajp_string("www.server-example.com"),

        <<
        2:8,                            %byte JK_AJP13_FORWARD_REQUEST
        2:8,                            %byte GET
        L0:16, Protocol/binary,         %string
        L1:16, Request_uri/binary,      %string
        L2:16, Remote_addr/binary,      %string
        L3:16, Remote_host/binary,      %string
        L4:16, Server_name/binary,      %string
        80:16,                          %integer
        0:8,                            %boolean
        1:16,                           %integer
        16#A0, 16#0B,                   %Header: Host
        L4:16, Server_name/binary,      %Servername
        16#ff                           %terminator
        >>.

ajp_string(String) ->
        S = list_to_binary(String),
        Bin = <<S/binary, 0>>,
        {Bin, size(Bin) - 1}.

The 'ajp_string/1' is used to calculate the final size of the binary data, and is simply used with the ajp13 string encoding format...

BTW, it's really time consuming to explain code ! When I started this article I was thinking that I'll finish it rather quickly, and I realise now that's not the case, there's so many things to say...
This is why I stop here for the First Part, the next part will come tomorrow...

Parallelizing simple external commands ... Part II

2007-07-19T21:52:00.000+02:00

Our loop/3 fun looks like this:


loop(_Max, 0, []) ->
     unregister(computing_master),
     exit(normal);

Whenever our list of jobs is empty, we deregister the 'computing_master' process and quit normally.


loop(Max, Current, []) ->
     receive
             stop ->
                     unregister(computing_master),
                     exit(normal);

             {exited, _Result} ->
                     io:format("Still ~p childs~n", [Current]),
                     loop(Max, Current - 1, []);

             E ->
                     io:format("Unhandled message: ~p~n", [E])

     after 60000 ->
             io:format("~p: Waiting for the last process ~p/~p~n", [erlang:now(), Max, Current]),
             loop(Max, Current, [])
     end;

In this case, we have are computing the last external process since our job list is empty.
And finally this version of loop/3 is the main one:


loop(Max, Current, List)  ->
     receive
             stop ->
                     unregister(computing_master),
                     exit(normal);

             {update, NewMax} ->
                     upto(NewMax, Max, List);

             {exited, _Result} ->
                     io:format("Still ~p childs~n", [Max]),
                     upto(Max, Max - 1, List);

             E ->
                     io:format("Unhandled message: ~p~n", [E])

     after 60000 ->
             io:format("~p: Running ~p processes~n", [erlang:now(), Max]),
             upto(Max, Current, List)
     end.

Here we have a non empty list of job and a number of job to start.

Every 60 seconds we write how many processes are running.
The message {update, NewMax} let's you alter the number max of concurrent tasks
The message {exited, _Result} is received whenever a child process dies, so we restart another job...

Bonus Code, a simple function to test the code:


sleep(Ident) ->
        io:format("Waiting ~p~n", [Ident]),
        Delay = [ "5", "3", "15", "8" ],
        Time = lists:nth(random:uniform(4), Delay),
        Cmd = [ "sleep ", Time ], 
        io:format("Starting: ~p~n", [Cmd]),
        Status = os:cmd(Cmd),
        computing_master ! {exited, Status}.

This code just calls the 'sleep' command with various arguments picked randomly... Once a process stops the 'os:cmd/1' fun exits and 'computing_master' will receive the {exited, Status} message (explained above)

Parallelizing simple external commands ... Part I

2007-07-17T23:33:00.000+02:00

Once upon a time I need to parse enormous files to find simple patterns... My prefered tools were so far the shell based one, i.e. 'grep'.

But now I have a Magical Ability, Erlang Magic... So I decide to split this enormous file, using the 'split' comand, 'split -l 10000' for example.

Now that I have a lot of smaller file, I can parallelize their parsing, and this is were erlang comes...

First, let's design a bit:

I need a central process that will control all my processes
Processes and master must be able to communicate

That's all. Hopefully the latter is directly provided by erlang, this the ! operator.
The master process will be a little more tricky, but this is 'easyerl' remember, so here we go:


doit(Step) ->
    Master = spawn(?MODULE, test, [Step]),
    register(computing_master, Master).

test(Step) ->
    file:set_cwd("/home/rolphin/Work"),
    List = filelib:wildcard("seg-a*"),
    upto(Step, 0, List).

We create a process running the test function, whose job is starting the upto/3 fun...
What's interesting here is the 'filelib' function that provides me the list of file contained in the directory '/home/rolphin/Work'.

Now we go describe the 'upto/3' fun :


upto(Max, Current, []) ->
    loop(Max, Current, []);

upto(Max, Max, List) ->
    loop(Max, Max, List);

upto(Max, Current, [New|List]) ->
    io:format("upto: ~p/~p~n", [Max, Current]),
    spawn(?MODULE, grep, ["user.list", New, ["result-", New]]),
    upto(Max, Current + 1, List).

More details:

upto with an empty list will just call the loop/3 fun
upto with the Max number of processe allowed equals the current number of process, will call loop/3
upto with less active process than the max, with a non empty list, will spawn a child process

The child process is a 'grep' command, and here it is:


grep(File, Source, Result) ->
       % Command line is: "grep -f motif_file sourcefile > result"
       Cmd = [ "grep -f ", File , $ , Source, $>, Result ],
       io:format("Starting: ~p~n", [Cmd]),
       Status = os:cmd(Cmd),
       computing_master ! {exited, Status}.

Okay that's it for today ! It's a little late now ! And I need some sleep to succesfully pass the required skill tests for my new job !

More of this tomorrow...

Simple command execution

2007-07-03T11:05:00.000+02:00

Sometimes you need to run external commands, and just need the return value or exit code...
One simple way to do this is the following:


-module(tport).
-export([ execute/2 ]).

execute(Host, Cmd) ->
 Port = open_port({spawn, Cmd}, [ {cd, Host}, exit_status, binary ] ),
 wait(Port).

wait(Port) ->
 receive 
  {Port, {data, BinData}} ->
   io:format("dump:~n~p~n", [BinData]),
   wait(Port);
  {Port, {exit_status, Status}} ->
   io:format("exit_code: ~p~n", [Status]);
  %% {Port, eof} ->
  %%  port_close(Port);
  {Port, exit} ->
   io:format("Received : ~p~n", [Port])
 end.

Once a port opened your process will receive various messages and one we're interested in is the 'exit_status' one:


  {Port, {exit_status, Status}} ->
   io:format("exit_code: ~p~n", [Status]);

The variable 'Status' will hold the exit code.

Simple isn't it ?

Using ports for fast templating...

2007-06-26T20:56:00.000+02:00

I find myself many times searching for fast templating system, and I always stop my search by developing one myself. ( the one is done using flex generated code, which means that it is very fast... )

Here, I need some fast (rather simple) template system that gives me some data to send later to an SMTP server (the body of the mail).

First the code:

get(Template, Args) ->
     NewArgs = list_to_shell(Args),
     Cmd = lists:flatten([ ?engine, $ , "conf/template/", Template, $ , NewArgs ]),
     Port = open_port({spawn, Cmd}, [ {cd, code:lib_dir(mmailer)}, stream, binary]),
     process_flag(trap_exit, true),
     loop(Port).

You'll find some unknown notation: '?engine' and $.

?engine is a macro, defined like this -define(engine, "templater").
$ is the character notation, the character that follows the dollar sign is the character I want. Actually I need the space character...

Now the function list_to_shell:

list_to_shell(Args) ->
      L = lists:map(fun(X) -> [X, $ ] end, Args),
      lists:flatten(L).

This function add a space after after element of the array passed as parameter. I construct the shell command this way.

The call to open_port is the main part of the code:

Port = open_port({spawn, Cmd}, [ {cd, code:lib_dir(mmailer)}, stream, binary]),

The following describe what the above line does:

spawn the command 'Cmd'
in the directory code:lib_dir(mmailer),
this command will write data as a stream
and I want erlang to give me a binary stream.

(code:lib_dir(mmailer) gives me the directory where the mmailer module is located)

More about my engine... My engine takes as firts arguments the template file to parse and every other parameter is saved as $1, or $2, or $3 etc.

Example of a template 'test.template'

Hello $1 $2 !
We have a good news for you, join us at url/$3

So calling:

templater test.template Mister John connect?John

Will compute the following:

Hello Mister John !
We have a good news for you, join us at url/connect?John

Conclusion, you can use whatever template system efficiently with the open_port function, since you can dynamically build the command line.

NB: I've not secure the line generated by list_to_shell, any '; rm -rf *' in the command line will do nasty things with your stuff :)

Atoms...

2007-06-26T12:10:00.000+02:00

Atoms, Variable, what they are and what you can do with them ?

Atoms are what you'll find strange at the first look, you may ask yourself
continously, but where the hell this thing is defined !!

Relax and just read the following words, atoms are just there to document your code...
So they can appear anywhere, have no special meaning or just may be funny !
You'll find them most of the time tagging tuples, example:


test() ->
        % code that fails
        {error, "Can't find file"}.

This way you can try to match 'error', and bind a Variable to the reason:


case test() of
        {ok, Result} ->
                Result;
        {error, Reason} ->
                io:format("Error: because ~p~n", [Reason])
end;

Simple isn't it ?

Erlang and calling functions

2007-06-12T00:04:00.001+02:00

In Erlang, when you want to call a function you can use various notations:


modulename:functionname(arguments).
functionname(arguments).

Calling a function in another process:


NewPid = spawn(modulename, functionname, [arguments]).

Now a simple test module:


-module(test).
-export([test/1]).

test(String) ->
  { erlang:now(), String }.

This module has one function named 'test', its arity is one (one parameter), and this function
returns a tuple that contains the datetime and the 'string' passed as the parameter.

Calling 'erlang:now()':


(master@karoten)52> erlang:now().
{1181,599629,877590}
(master@karoten)53>

This is some sort of UNIX timestamp (number of seconds since 1970).

Now test our module:

Compiling it, ie compiling 'test.erl' located in the current directory:


(master@karoten)52> c(test).
ok

Calling the funcname 'test':


(master@karoten)53> test:test("test").
{{1181,599702,993670},"test"}
(master@karoten)54>

Here's we have used the notation 'modulename:functionname(arguments)'.
But within the module itself we could use the notation 'functionname(arguments)'...


-module(test).
-export([test/1, test/0]).

test(String) ->
  { erlang:now(), String }.

test() ->
  test("test").

Here's come what's really important to understand in Erlang, a function is defined by its name AND its arity.
So 'test/0' is NOT 'test/1'.

In our module, what the function 'test/0' do is just calling 'test/1' with a string that contains 'test'.

Erlang is a functionnal language, so the parameter of the function 'test/1' can really be what you want, from simple string to integer to complex list of tuple...

Just try this, and you'll understand :


test:test( [ complex, list, of, atoms, "and a string" ] ).

Shrink or Strip a binary octet-stream easily

2007-06-10T15:38:00.002+02:00

I've found a simple way to suppress ending characters of a Binary without parsing it or change it into a list !

I wanted to remove those <<"\r\n">> characters from lines read from a file, and know that my line are made of 29 characters (reading date strings).

So with this function:


shrinkbin(Data, Size) ->
  <<Data:Size/binary-unit:8>>.

I can do:


node> test:shrinkbin(<<"Sun Jun 10 15:20:53 CEST 2007\r\n">>, 29).
<<"Sun Jun 10 15:20:53 CEST 2007">>.

That's it !

Matching Protocol status code using Binary notation .

2007-06-10T00:56:00.000+02:00

Once you're succesfully connected to some remote host, you may need to read what this peer sends you...

Sometimes the protocol is using simple integer number to describe what's going on. Let's have a look at the SMTP protocol:
2XX are ok codes,
5XX are error codes.

Testing Binary matching:


-module(bintest).
-export([test/0, check/1]).

test() ->
   Bin = <<"200 OK\r\n">>,
   check(Bin).

check(<<"200", Rest/binary>>) ->
   {200, Rest};
check(<<"300", Rest/binary>>) ->
   {300, Rest};
check(_Bin) ->
   {800, unknown}.

Sorting Mx servers using their preference number...

2007-06-09T17:15:00.000+02:00

Once you've retrieved your mx lists, you want to be kind enough to gently contact mx server in their prefered order...

In erlang, sorting a list is done with sort function like 'keysort'.


SortedList = lists:keysort(1, List).

lists:keysort uses as first parameter, the nth element of the tuple to use in the sort, and as second parameter the tuple list you want to sort...

Once you've sorted your tuple list, you may want to remove the key you use to sort, lists:unzip remove this...

Finally, retrieving a mx list, sorting it, and directly using it can be done like this:


mxlist(Domain) ->
 List = get_mx(Domain),
 {_, Hosts} = lists:unzip( lists:keysort(1, List) ),
 Hosts.

Configuring your DNS server for inet_res.

2007-06-07T08:49:00.000+02:00

When using inet_res, you must configure a DNS server to query, this could be done like this:


-define(MASTER_DNS, {212,XX,XX,252}).

init() ->
 inet_db:add_ns(?MASTER_DNS).

Once you've called your ?MODULE:init/1 you're able to use your ?MODULE:get_mx/1 function.


node> mail:init().
ok

node> mail:get_mx("yahoo.com").                                                       
[{1,"e.mx.mail.yahoo.com"},
 {1,"a.mx.mail.yahoo.com"},
 {1,"b.mx.mail.yahoo.com"},
 {1,"c.mx.mail.yahoo.com"},
 {1,"d.mx.mail.yahoo.com"},
 {1,"f.mx.mail.yahoo.com"},
 {1,"g.mx.mail.yahoo.com"}]

The result is a list of tuples, the first element is the server weight, the second the server name :p

Retrieve MX DNS record using erlang inet_res, it's easy !

2007-06-06T23:32:00.000+02:00

Ever needed to retrieve some MX servers from any big domains out there ?

I'm pretty sure that you've asked yourself this question, right ?

It's EasyErl here, so let's go to the code directly:


get_mx(Domain) ->
       {ok, {hostent, Domain, _, _, _Len, List}} = inet_res:getbyname(Domain, mx),
       List.

Woh ! This wasn't too much difficult !

Okay, inet_res:getbyname isn't really well documented that's right, but Erlang comes with its source code, what's a better Erlang documentation than Erlang himself ?

The next time, I'll show you how you can easily sort the List by using unzip to obtain a correct list of MX servers... (where servers weight are correctly used)