Friday, May 18, 2012

erlangs gen_fsm with queueing

OK no time for a full blow, polished blog post; When using gen_fsm I realized that often I want some sort of queueing. Two reasons promote this:
  1. to reduce the complexity caused by {States} x {Events}
  2. to implement some kind of asynchronous command execution processing model

I usualle encounter both reasons and I ended up with two useful function that I copy into every gen_fsm I build:

deq(State = #state{evtq = []}) ->
    {next_state, ready, State};
deq(State = #state{evtq = [Msg | T]}) ->
    ?MODULE:ready(Msg, State#state{evtq = T}).

This requires one adds evtq as a field to the #state{} record.

The function deq/1 will be used to work of events(one could say commands) until the queue is empty and finally rests in the state ready.

This function is called at the point where one would return {next_state, ready, State} So instead of transitioning directly to ready we call the deq function which will process all defered events.

On the other hand there is a function enq/2 which is called whenever the process is in a state where it cannot handle a new request, and wants to defer the event:

enq(Msg, State = #state{evtq = EvtQ}) ->
    State#state{evtq = EvtQ ++ [Msg]}.

Isn't this helpful? compared to the complexity this little trick offers a lot of value for me.

Here is a small example; Imagine a gen_fsm representing an RTP connection. The connection must be established by some dsp processing hardware and the dsp will tell the process when it's done asynchronously.

After that, the connection calls a callback provided by the user to indicate the connection can now be assumed established. Some time in the future the user requests the RTP connection process to tell the dsp resource to stop sending data to the rtp destination, and the connection process will exit.

Now there are quite a few clauses in this li'll statemachine, because the user might send the disconnect request anytime before or after the rtp connection is established.

To handle this the process simply queues the disconnect request until it is ready. I hope this incomplete piece of code helps:

-module(rtp_connection).

-behaviour(gen_fsm).

-export(.....).

start_link(...) -> ...


[gen_fsm boilerplate]

%%------------------------------------------------------------------------------
%% @doc
%% Will exit the processes and reset the RTP destination of the voice channel.
%% @end
%%------------------------------------------------------------------------------
-spec disconnect(core_rtp:connection()) ->
       ok.
disconnect(Ref) ->
    gen_fsm:send_event(lbm_object:pid(Ref), disconnect).

%%%=============================================================================
%%% acme_voice_channel_op Callbacks
%%%=============================================================================

%%------------------------------------------------------------------------------
%% @private
%%------------------------------------------------------------------------------
update(CBRef, Ctx) ->
    gen_fsm:sync_send_event(lbm_object:pid(CBRef), {perform_update, Ctx}).

%%------------------------------------------------------------------------------
%% @private
%%------------------------------------------------------------------------------
voice_config_succeeded(CBRef) ->
    gen_fsm:send_event(lbm_object:pid(CBRef), update_success).

%%------------------------------------------------------------------------------
%% @private
%%------------------------------------------------------------------------------
voice_config_failed(CBRef) ->
    gen_fsm:send_event(lbm_object:pid(CBRef), update_failure).

%%%=============================================================================
%%% gen_fsm Callbacks
%%%=============================================================================

-record(state, {
          self_ref :: core_connection:ref(),
          channel  :: pid(),
          rtp_dest :: core_rtp:endpoint(),
          rtp_cb   :: core_rtp_cb:ref(),
          evtq     :: [any()]}).

%%------------------------------------------------------------------------------
%% @private
%%------------------------------------------------------------------------------
init({ChannelPid, RTPDest, RTPCB, ChannelEP}) ->
    Ref = core_connection:ref(self(), ?MODULE, ChannelEP, RTPDest),
    gen_fsm:send_event(self(), connect),
    {ok,
     initializing,
     #state{
       self_ref = Ref,
       channel = ChannelPid,
       rtp_dest = RTPDest,
       rtp_cb = RTPCB,
       evtq = []}}.

%%%=============================================================================
%%% gen_fsm state functions
%%%=============================================================================

%%------------------------------------------------------------------------------
%% @private
%%------------------------------------------------------------------------------
initializing(connect, State = #state{channel = Ch}) ->
    Self = acme_voice_channel_op:ref(self(), ?MODULE),
    acme_voice_channel:request_update(Ch, Self),
    {next_state, initializing, State};

initializing(M, State) ->
    {next_state, initializing, enq(M, State)}.

%%------------------------------------------------------------------------------
%% @private
%%------------------------------------------------------------------------------
initializing({perform_update, Ctx},
             _From,
             State = #state{rtp_dest = RtpDest}) ->
    NewCtx = acme_channel_common:set_rtp_dest(Ctx, RtpDest),
    {reply, NewCtx, connecting, State}.

%%------------------------------------------------------------------------------
%% @private
%%------------------------------------------------------------------------------
connecting(update_failure, State) ->
    {stop, voice_config_failed, State};
connecting(update_success, State = #state{self_ref =  Self,
                                          rtp_cb = RtpCB}) ->
    core_rtp_cb:rtp_connected(RtpCB, Self),
    deq(State);

connecting(M, State) ->
    {next_state, connecting, enq(M, State)}.

%%------------------------------------------------------------------------------
%% @private
%%------------------------------------------------------------------------------
ready(disconnect, State = #state{channel = Ch}) ->
    Self = acme_voice_channel_op:ref(self(), ?MODULE),
    acme_voice_channel:request_update(Ch, Self),
    {next_state, disconnecting, State};

ready(Msg, State) ->
    error_logger:error_report(acme_driver,
                              [{?MODULE, self()}, {ignoring, Msg}]),
    deq(State).
%%------------------------------------------------------------------------------
%% @private
%%------------------------------------------------------------------------------
disconnecting({perform_update, Ctx},
              _From,
              State) ->
    NewCtx = acme_channel_common:reset_rtp_dest(Ctx),
    {reply, NewCtx, disconnecting, State}.

%%------------------------------------------------------------------------------
%% @private
%%------------------------------------------------------------------------------
disconnecting(update_failure, State) ->
    {stop, voice_config_failed, State};
disconnecting(update_success, State) ->
    {stop, normal, State}.

%%------------------------------------------------------------------------------
%% @private
%%------------------------------------------------------------------------------
deq(State = #state{evtq = []}) ->
    {next_state, ready, State};
deq(State = #state{evtq = [Msg | T]}) ->
    ?MODULE:ready(Msg, State#state{evtq = T}).

%%------------------------------------------------------------------------------
%% @private
%%------------------------------------------------------------------------------
enq(Msg, State = #state{evtq = EvtQ}) ->
    State#state{evtq = EvtQ ++ [Msg]}.

Thanks for reading, feedback very welcome.

Follow me on Twitter @SvenHeyll

Sunday, February 06, 2011

New Erlymock Release

The project has evolved and can be found here: ErlyMock

Sunday, November 07, 2010

Age

Sadly, I will never be as young as I am right now. Luckily, I will neither be any older than I am in the present moment.

Sunday, August 01, 2010

My minimalistic xinitrc, xmonad.hs and xmobarrc

put this in ~/.xinitrc

ck-launch-session

# start trayer to contain apps like nm-applet
trayer --edge top --align right --SetDockType true --SetPartialStrut true --expand true --width 5 --transparent true --tint 0x191970 --height 12 &

kmix &

# some cool effects
xcompmgr -c -f -F &

# Set the background color
hsetroot -tile /home/sven/Wallpapers/abstract-bluelights-1280x800-.jpg

xset b 100 0 0
xset r rate 190 90
dbus-launch --exit-with-session xmonad


put this in ~/.xmonad/xmonad.hs
import XMonad

import qualified XMonad.StackSet as W
import XMonad.ManageHook
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.FadeInactive()
import XMonad.Hooks.SetWMName(setWMName)
import XMonad.Layout.NoBorders(smartBorders)
import XMonad.Layout.Tabbed(tabbed, shrinkText, defaultTheme)
import XMonad.Layout.LayoutHints(layoutHints)
import XMonad.Layout.LayoutModifier
import XMonad.Util.Run(spawnPipe)
import XMonad.Util.EZConfig(additionalKeys)
import System.IO

import XMonad.Prompt(defaultXPConfig, autoComplete, XPPosition(Bottom), position)
import XMonad.Prompt.RunOrRaise(runOrRaisePrompt)
import XMonad.Actions.WindowGo(runOrRaiseNext)
import XMonad.Actions.UpdatePointer()
import XMonad.Prompt.Man(manPrompt)
import XMonad.Prompt.Window(windowPromptGoto)
import XMonad.Util.Themes()

main = do
mobar <- spawnPipe "/usr/bin/xmobar ~/.xmonad/xmobarrc"
xmonad $ defaultConfig { manageHook = manageDocks <+> customManageHooks <+> manageHook defaultConfig
, layoutHook = avoidStruts sheyllLayouts
, modMask = windowsKey -- rebind ALT modifier key to WIN
, logHook = myLogHook mobar
, terminal = "konsole"
, startupHook = setWMName "LG3D"
} `additionalKeys` sheyllShortCuts
where myLogHook mobar = dynamicLogWithPP sjanssenPP { ppOutput = hPutStrLn mobar
}

customManageHooks = composeAll [ className =? "ioUrbanTerror" --> doFullFloat
, className =? "XConsole" --> doFloat
, className =? "Kcalc" --> doFloat
, className =? "Pidgin" --> doFloat
, className =? "Kmix" --> doFloat]

windowsKey = mod4Mask

sheyllLayouts = smartBorders $
tabbed shrinkText defaultTheme
||| layoutHints (layoutHook defaultConfig)

sheyllShortCuts = [ ((windowsKey, xK_p), runOrRaisePrompt defaultXPConfig
{ position = Bottom
, autoComplete = Just 500000 })
-- important apps
, ((windowsKey, xK_Return), runOrRaiseNext "konsole"
(className =? "Konsole"))
, ((windowsKey, xK_f), runOrRaiseNext "google-chrome"
(className =? "Google-chrome"))
, ((windowsKey .|. shiftMask, xK_f), spawn "google-chrome")

, ((windowsKey, xK_a), runOrRaiseNext "emacs" (className =?
"Emacs"))
, ((windowsKey .|. shiftMask, xK_a), spawn "emacs")

, ((windowsKey, xK_d), runOrRaiseNext "dolphin" (className
=? "Dolphin"))
, ((windowsKey .|. shiftMask, xK_d), spawn "dolphin")

, ((windowsKey, xK_End), kill)

-- eclipse IDE
, ((windowsKey, xK_x), runOrRaiseNext "eclipse" (className =?
"Eclipse"))
, ((windowsKey .|. shiftMask, xK_x), spawn "eclipse")


-- launch a mail programm
, ((windowsKey, xK_m ), runOrRaiseNext "kmail" (className =? "Kmail"))

-- switch kb to de
, ((windowsKey, xK_BackSpace), spawn "setxkbmap de")

-- switch kb to us
, ((windowsKey .|. shiftMask, xK_BackSpace), spawn "setxkbmap us")

-- launch pidgin
, ((windowsKey, xK_i ), runOrRaiseNext "pidgin" (className =? "Pidgin"))

-- sound & media
, ((windowsKey, xK_v), runOrRaiseNext "rhythmbox" (className
=? "Rhythmbox"))

-- put system into hibernate mode
, ((windowsKey .|. shiftMask .|. controlMask, xK_r), spawn "sudo reboot")


-- Toggle docks gaps
, ((windowsKey , xK_b), sendMessage ToggleStruts)

-- prompt, runOrRaise
, ((windowsKey .|. controlMask, xK_x), runOrRaisePrompt
defaultXPConfig)
, ((windowsKey, xK_F1), manPrompt defaultXPConfig)

-- finding windows
, ((windowsKey, xK_g ), windowPromptGoto
defaultXPConfig { autoComplete = Just 500000 } )
]
++
-- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
-- mod-shift-{w,e,r}, Move client to screen 1, 2, or 3
--
[((m .|. windowsKey, key), screenWorkspace sc >>= flip whenJust (windows . f))
| (key, sc) <- zip [xK_e, xK_w, xK_r] [0..]
, (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]



place this in ~/.xmonad/xmobarrc:


Config { font = "-*-Fixed-Bold-R-Normal-*-13-*-*-*-*-*-*-*"
, bgColor = "black"
, fgColor = "grey"
, position = TopW L 95
, lowerOnStart = True
, commands = [ Run Memory ["-t","Mem: %"] 10
, Run Swap [] 10
, Run Battery ["-t","Batt: "] 10
, Run Thermal "THRM" [] 10
, Run Network "eth0" ["-L","0","-H","32","--normal","green","--high","red"] 10
, Run Memory ["-t","Mem: %"] 10
, Run MultiCpu ["-t", "CPU: ","-L","3","-H","50","--normal","green","--high","red"] 10
, Run Date "%a %b %_d %Y %H:%M:%S" "date" 10
, Run StdinReader
]
, sepChar = "%"
, alignSep = "}{"
, template = "%StdinReader%} {%multicpu% << %memory% << %swap% << %eth0% << %date%"
}

Thursday, May 13, 2010

Installing GHC 6.12.2 on Red Hat Entrprise Linux 5.4 (i386)

Haskell, a general-purpose, purely functional programming language, has become more and more interesting for me, it allows me to write maintainable code, with acceptable performance even for tasks like analyzing large log files. I recently discovered how easy it is to write programs interacting with a unix like environment. It also very easy to write networking code. Haskell offers great opportunities for TDD and SDD through HUnit and QuickCheck, which - together with the pure and strong static type system of the language itself - enable trust in program correctness, which is vital for many commercial applications, or applications exposed to increased security requirements.

In order to leverage the outstandingly great features of Haskell, one has to have that beast running on a stable, proven and hence archaic and outdated operating system. Even if one is not a firm believer in magical awesomeness of Enterprise labels on top of ridiculously obsolete tools(like gcc 4.1 and glibc 2.5), the server landscape might require to use a specific Linux distribution, because of proprietary drivers for specialized hardware components, in this post I will assume that this Linux distro is Red Hat Entrprise Linux 5.4 and explain the cumbersome installation of the latest and greatest Haskell compiler.

Step 0: Preparing the build environment


As a non-commercial 100% binary compatible replacement for RHEL with only the proprietary art work replaced Cent OS should be used. I installed Cent OS 5.4 i386 without any GNOME or KDE and with bridge networking in a Virtual Box with on an Arch Linux host.

Step 1: Installing GHC 6.8.3


Because the generic binary linux distribution of GHC 6.12.2 depends on at least the 2.7 version of glibc, and RHEL 5.4 only provides glibc 2.5, it is necessary to build it from the sources. Strangely the GHC source distribution needs an existing GHC to compile it: in order to compile GHC 6.12.2 from source we need to have a GHC already installed. The latest GHC version with a generic linux binray distribution compatible with glibc 2.5 is GHC 6.8.3.

These are the required commands(execute as root) to install GHC 6.8.3 into /usr/local:

[root@noname ~]# wget http://haskell.org/ghc/dist/6.8.3/ghc-6.8.3-i386-unknown-linux.tar.bz2
[root@noname ~]# tar xvfj ghc-6.8.3-i386-unknown-linux.tar.bz2
[root@noname ~]# cd ghc-6.8.3
[root@noname ghc-6.8.3]# ./configure
[root@noname ghc-6.8.3]# make install

Try running ghci, the interactive Haskell REPL, it should start and welcome its user with a warm...

[root@noname ~]# ghci
GHCi, version 6.8.3: http://www.haskell.org/ghc/ :? for help
Loading package base ... linking ... done.
Prelude>


Step 2: Building GHC-6.12.2


GHC 6.12.2 can now be built from source using the GHC 6.8.3 from the previous build...

wget http://haskell.org/ghc/dist/6.12.2/ghc-6.12.2-src.tar.bz2
tar xfvj ghc-6.12.2-src.tar.bz2
cd ghc-6.12.2
./configure
make

STOP do not make install just yet. Before, move your /usr/local/ to /usr/local.ghc683 in order to get a clean
install of GHC 6.12 in /usr/local with make install.

Harvest the result of your hard work


Now would be an excellent moment to save a snapshot of your /usr/local directory.
If I knew where I would even upload an archived version of mine.

Sunday, May 09, 2010

haskell stuff in my .emacs

This does not include the ghc-mod configuration.

;; haskell section:
(load "/usr/share/emacs/site-lisp/haskell-mode/haskell-site-file.el")
(require 'inf-haskell)
(autoload 'turn-on-haskell-doc-mode "haskell-doc" nil t)
(add-hook 'haskell-mode-hook 'heyllStd)
(add-hook 'haskell-mode-hook 'turn-on-haskell-font-lock)
(add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan)
(add-hook 'haskell-mode-hook 'turn-on-haskell-indent)
(add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode)
(add-hook 'haskell-mode-hook 'turn-on-haskell-ghci)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;