Skip to content
Browse files

Initial import - doesn't really work at all yet

  • Loading branch information...
0 parents commit b77f9cfb1fbc42b3e033f057deb986b4dae5d909 @Vagabond committed May 10, 2011
Showing with 669 additions and 0 deletions.
  1. +7 −0 Makefile
  2. BIN rebar
  3. +11 −0 rebar.config
  4. +13 −0 src/diemap.app.src
  5. +11 −0 src/diemap_server.erl
  6. +333 −0 src/diemap_session.erl
  7. +203 −0 src/imap_parser.peg
  8. +57 −0 src/imap_server_example.erl
  9. +34 −0 test/imap_parser_test.erl
7 Makefile
@@ -0,0 +1,7 @@
+compile:
+ @./rebar compile
+
+clean:
+ @./rebar clean
+
+.PHONY: compile clean
BIN rebar
Binary file not shown.
11 rebar.config
@@ -0,0 +1,11 @@
+%% -*- mode: erlang; -*-
+
+{erl_opts, [fail_on_warning, debug_info, warn_unused_import, warn_exported_vars]}.
+{deps, [{cowboy, ".*", {git, "git://github.com/Vagabond/cowboy.git", "HEAD"}},
+ {iconv, ".*", {git, "git://github.com/Vagabond/erlang-iconv.git", "HEAD"}},
+ {neotoma, ".*", {git, "git://github.com/Vagabond/neotoma.git", "HEAD"}}]}.
+{cover_enabled, true}.
+{cover_print_enabled, true}.
+
+{pre_hooks, [{compile, "erl -noshell -noinput -pa deps/neotoma/ebin -eval \"neotoma:file(\\\"src/imap_parser.peg\\\"),halt().\""}]}.
+
13 src/diemap.app.src
@@ -0,0 +1,13 @@
+%% -*- mode: erlang; -*-
+
+{application, diemap,
+ [
+ {description, "A modular IMAP server written in erlang"},
+ {vsn, "0.1"},
+ {modules,
+ [
+ ]
+ },
+ {applications, [kernel, stdlib, cowboy, iconv]}
+ ]
+}.
11 src/diemap_server.erl
@@ -0,0 +1,11 @@
+-module(diemap_server).
+
+-export([start/1]).
+
+start(Module) ->
+ application:start(cowboy),
+ %% Name, NbAcceptors, Transport, TransOpts, Protocol, ProtoOpts
+ cowboy:start_listener(imap, 100,
+ cowboy_tcp_transport, [{port, 1430}],
+ diemap_session, [Module]
+ ).
333 src/diemap_session.erl
@@ -0,0 +1,333 @@
+
+-module(diemap_session).
+-behaviour(gen_fsm).
+
+%% gen_fsm exports$
+-export([init/1, handle_event/3, handle_sync_event/4, handle_info/3, terminate/3, code_change/4]).
+%% state exports
+-export([unauthenticated/2, authenticated/2, selected/2]).
+-export([unauthenticated/3, authenticated/3, selected/3]).
+%% other exports
+-export([start_link/3, parse_quoted_list/1, parse_argument_list/1]).
+
+-record(state,
+ {
+ socket :: port(),
+ transport :: atom(),
+ mailbox :: binary(),
+ module :: atom(),
+ modstate :: term()
+ }
+).
+
+start_link(Socket, Transport, Options) ->
+ Transport:setopts(Socket, [{active, once}, {packet, line}]),
+ gen_fsm:start_link(?MODULE, [Socket, Transport, Options], []).
+
+init([Socket, Transport, [Module | Options]]) ->
+ {ok, Peername} = Transport:peername(Socket),
+ case Module:init(Peername, proplists:get_value(moduleoptions, Options, [])) of
+ {ok, State} ->
+ reply(Transport, Socket, "* OK server ready\r\n"),
+ {ok, unauthenticated, #state{socket=Socket, transport=Transport, module=Module, modstate=State}};
+ {stop, Message, Reason} ->
+ reply(Transport, Socket, ["* BYE ", Message, "\r\n"]),
+ {stop, Reason}
+ end.
+
+unauthenticated({command, Tag, <<"LOGIN">>, Args},
+ #state{transport=Transport,socket=Socket,module=Module,modstate=ModState} = State) ->
+ case parse_argument_list(Args) of
+ [User, Pass] ->
+ case Module:handle_LOGIN(User, Pass, ModState) of
+ {ok, NewModState} ->
+ reply(Transport, Socket, [Tag, " OK LOGIN completed\r\n"]),
+ {next_state, authenticated, State#state{modstate=NewModState}};
+ {error, NewModState} ->
+ reply(Transport, Socket, [Tag, " NO LOGIN failed\r\n"]),
+ {next_state, unauthenticated, State#state{modstate=NewModState}}
+ end;
+ _ ->
+ reply(Transport, Socket, [Tag, " BAD LOGIN bad arguments\r\n"]),
+ {next_state, unauthenticated, State}
+ end;
+unauthenticated(_Msg, State) ->
+ {next_state, unauthenticated, State}.
+
+unauthenticated(_Msg, _From, State) ->
+ {next_state, unauthenticated, State}.
+
+authenticated({command, Tag, <<"LIST">>, Args}, #state{transport=Transport,socket=Socket} = State) ->
+ case parse_argument_list(Args) of
+ [Reference, <<>>] ->
+ Root = case Reference of
+ <<>> ->
+ <<>>;
+ _ ->
+ [H|_] = binstr:split(Reference, <<"/">>),
+ H
+ end,
+ reply(Transport, Socket, ["* LIST (\\NOSELECT) \"/\" \"", Root, "\"\r\n", Tag, " OK LIST completed\r\n"]),
+ {next_state, authenticated, State};
+ [_Reference, _Mailbox] ->
+ reply(Transport, Socket, [Tag, " BAD LIST no such mailbox\r\n"]),
+ {next_state, authenticated, State}
+ end;
+authenticated({command, Tag, <<"SELECT">>, Mailbox},
+ #state{transport=Transport,socket=Socket,module=Module,modstate=ModState} = State) ->
+ MailboxName = case binstr:to_lower(Mailbox) of
+ <<"inbox">> ->
+ %% inbox is a magical special case that needs to be treated case insensitively
+ inbox;
+ X -> X
+ end,
+ case Module:handle_SELECT(MailboxName, ModState) of
+ {ok, {Count, Recent, Unseen, Flags, PermanantFlags, UIDNext, UIDValidity, RW}, NewModState} ->
+ ReadWrite = case RW of
+ read_only ->
+ "READ-ONLY";
+ read_write ->
+ "READ-WRITE"
+ end,
+ reply(Transport, Socket, [
+ "* ", integer_to_list(Count), " EXISTS\r\n",
+ "* ", integer_to_list(Recent), " RECENT\r\n",
+ "* OK [UNSEEN ", integer_to_list(Unseen), "]\r\n",
+ "* OK [UIDNEXT ", integer_to_list(UIDNext), "]\r\n",
+ "* OK [UIDVALIDITY ", integer_to_list(UIDValidity), "]\r\n",
+ "* OK [PERMANANTFLAGS (", string:join(PermanantFlags, " "), ")\r\n",
+ "* FLAGS (", string:join(Flags, " "), ")\r\n",
+ Tag, " OK [", ReadWrite, "] SELECT completed\r\n"]),
+ {next_state, selected, State#state{mailbox=MailboxName, modstate=NewModState}};
+ {error, Message, NewModState} ->
+ reply(Transport, Socket, [Tag, " NO ", Message]),
+ {next_state, authenticated, State#state{modstate=NewModState}}
+ end;
+authenticated({command, Tag, Command, _Args}, #state{socket=Socket, transport=Transport} = State) ->
+ reply(Transport, Socket, [Tag, " BAD ", Command, " not recognized\r\n"]),
+ {next_state, authenticated, State};
+authenticated(_Msg, State) ->
+ {next_state, authenticated, State}.
+
+authenticated(_Msg, _From, State) ->
+ {next_state, authenticated, State}.
+
+selected({command, _Tag, <<"FETCH">>, Args}, State) ->
+ [SeqSet, Fields] = binstr:split(Args, <<" ">>, 2),
+ Sequence = parse_range(SeqSet),
+ [MsgFields] = parse_argument_list(Fields),
+ io:format("fields ~p~n", [Fields]),
+ io:format("sequence ~p~n", [Sequence]),
+ io:format("message fields ~p~n", [MsgFields]),
+ {next_state, selected, State};
+selected(_Msg, State) ->
+ {next_state, selected, State}.
+
+selected(_Msg, _From, State) ->
+ {next_state, selected, State}.
+
+handle_info({_SocketType, Socket, Packet}, StateName,
+ #state{socket = Socket, transport=Transport} = State) ->
+ io:format("C: [~p] ~s", [StateName, Packet]),
+ Command = parse_packet(Packet, State),
+ Result = case Command of
+ {command, Tag, <<"CAPABILITY">>, []} ->
+ do_capability(Tag, StateName, State);
+ {command, Tag, <<"CAPABILITY">>, _} ->
+ reply(Transport, Socket, [Tag, " BAD CAPABILITY takes no arguments\r\n"]),
+ {next_state, StateName, State};
+ {command, Tag, <<"NOOP">>, []} ->
+ do_noop(Tag, StateName, State);
+ {command, Tag, <<"NOOP">>, _} ->
+ reply(Transport, Socket, [Tag, " BAD NOOP takes no arguments\r\n"]),
+ {next_state, StateName, State};
+ {command, Tag, <<"LOGOUT">>, []} ->
+ do_logout(Tag, StateName, State);
+ {command, Tag, <<"LOGOUT">>, _} ->
+ reply(Transport, Socket, [Tag, " BAD LOGOUT takes no arguments\r\n"]),
+ {next_state, StateName, State};
+ _ ->
+ ?MODULE:StateName(Command, State)
+ end,
+ Transport:setopts(Socket, [{active, once}]),
+ Result;
+handle_info({tcp_closed, Socket}, _StateName, #state{socket = Socket} = State) ->
+ io:format("closed~n"),
+ {stop, normal, State};
+handle_info({ssl_closed, Socket}, _StateName, #state{socket = Socket} = State) ->
+ io:format("closed~n"),
+ {stop, normal, State};
+handle_info(_Info, StateName, State) ->
+ io:format("got info ~p~n", [_Info]),
+ {next_state, StateName, State}.
+
+code_change(_OldVsn, StateName, State, _Extra) ->
+ {ok, StateName, State}.
+
+handle_event(_Event, StateName, State) ->
+ {next_state, StateName, State}.
+
+handle_sync_event(_Event, _From, StateName, State) ->
+ {reply, ok, StateName, State}.
+
+terminate(_Reason, _StateName, _State) ->
+ ok.
+
+do_capability(Tag, StateName,
+ #state{socket=Socket,transport=Transport,module=Module,modstate=ModState} = State) ->
+ case Module:handle_CAPABILITY([], ModState) of
+ {ok, Capabilities, NewModState} ->
+ FullCapabilities = lists:usort(["IMAPrev1" | Capabilities]),
+ reply(Transport, Socket, ["* CAPABILITY ", string:join(FullCapabilities, " "), "\r\n",
+ Tag, " OK CAPABILITY completed\r\n"]),
+ {next_state, StateName, State#state{modstate=NewModState}};
+ {error, Message, NewModState} ->
+ reply(Transport, Socket, [Tag, " BAD ", Message, "\r\n"]),
+ {next_state, StateName, State#state{modstate=NewModState}}
+ end.
+
+do_noop(Tag, StateName,
+ #state{socket=Socket,transport=Transport,module=Module,modstate=ModState} = State) ->
+ case Module:handle_NOOP(ModState) of
+ {ok, NewModState} ->
+ reply(Transport, Socket, [Tag, " OK NOOP completed\r\n"]),
+ {next_state, StateName, State#state{modstate=NewModState}};
+ {error, Message, NewModState} ->
+ reply(Transport, Socket, [Tag, " BAD ", Message, "\r\n"]),
+ {next_state, StateName, State#state{modstate=NewModState}}
+ end.
+
+do_logout(Tag, StateName,
+ #state{socket=Socket,transport=Transport,module=Module,modstate=ModState} = State) ->
+ case Module:handle_LOGOUT(ModState) of
+ {ok, QuitMessage, NewModState} ->
+ reply(Transport, Socket, ["* BYE ", QuitMessage, "\r\n", Tag, " OK LOGOUT completed\r\n"]),
+ {stop, normal, State#state{modstate=NewModState}};
+ {error, Message, NewModState} ->
+ reply(Transport, Socket, [Tag, " BAD ", Message, "\r\n"]),
+ {next_state, StateName, State#state{modstate=NewModState}}
+ end.
+
+parse_packet(Packet, _State) ->
+ case binstr:split(binstr:chomp(Packet), <<" ">>, 3) of
+ [Tag, Command, Args] ->
+ {command, Tag, binstr:to_upper(Command), Args};
+ [Tag, Command] ->
+ {command, Tag, binstr:to_upper(Command), []}
+ end.
+
+parse_argument_list(List) ->
+ parse_argument_list(List, []).
+
+parse_argument_list(<<>>, Acc) ->
+ lists:reverse(Acc);
+parse_argument_list(<<$", Tail/binary>>, Acc) ->
+ {Arg, Rest} = read_string_argument(Tail),
+ parse_argument_list(Rest, [Arg | Acc]);
+parse_argument_list(<<$(, Tail/binary>>, Acc) ->
+ {Arg, Rest} = read_parenthesized_list(Tail),
+ parse_argument_list(Rest, [Arg | Acc]);
+parse_argument_list(<<$\s, Tail/binary>>, Acc) ->
+ parse_argument_list(Tail, Acc);
+parse_argument_list(Binary, Acc) ->
+ case binstr:strpos(Binary, <<" ">>) of
+ 0 ->
+ lists:reverse([Binary | Acc]);
+ Index ->
+ Arg = binstr:substr(Binary, 1, Index-1),
+ Tail = binstr:substr(Binary, Index+1),
+ parse_argument_list(Tail, [Arg | Acc])
+ end.
+
+read_string_argument(Binary) ->
+ read_string_argument(Binary, []).
+
+read_string_argument(<<>>, Acc) ->
+ {error, unterminated_string, Acc};
+read_string_argument(<<$\\, $", Tail/binary>>, Acc) ->
+ read_string_argument(Tail, [$"|Acc]);
+read_string_argument(<<$", Tail/binary>>, Acc) ->
+ {list_to_binary(lists:reverse(Acc)), Tail};
+read_string_argument(<<H, Tail/binary>>, Acc) ->
+ read_string_argument(Tail, [H|Acc]).
+
+read_parenthesized_list(Binary) ->
+ read_parenthesized_list(Binary, []).
+
+read_parenthesized_list(<<$), Tail/binary>>, Acc) ->
+ {lists:reverse(Acc), Tail};
+read_parenthesized_list(<<$", Tail/binary>>, Acc) ->
+ {Elem, Rest} = read_string_argument(Tail),
+ read_parenthesized_list(Rest, [Elem | Acc]);
+read_parenthesized_list(<<$(, Tail/binary>>, Acc) ->
+ {SubList, Rest} = read_parenthesized_list(Tail),
+ read_parenthesized_list(Rest, [SubList | Acc]);
+read_parenthesized_list(<<$\s, Tail/binary>>, Acc) ->
+ read_parenthesized_list(Tail, Acc);
+read_parenthesized_list(Binary, Acc) ->
+ case binstr:strpos(Binary, <<" ">>) of
+ 0 ->
+ case binstr:last(Binary) of
+ <<")">> ->
+ {lists:reverse([binstr:substr(Binary, 1, byte_size(Binary) -1) | Acc]), <<>>};
+ _ ->
+ {error, unterminated_list}
+ end;
+ Index ->
+ {Continue, CutPoint} = case binstr:strpos(Binary, <<")">>) of
+ 0 ->
+ {true, Index};
+ EndIndex when EndIndex < Index ->
+ {false, EndIndex};
+ _ ->
+ {true, Index}
+ end,
+ Arg = binstr:substr(Binary, 1, CutPoint-1),
+ Tail = binstr:substr(Binary, CutPoint+1),
+ case Continue of
+ true ->
+ read_parenthesized_list(Tail, [Arg | Acc]);
+ _ ->
+ {lists:reverse([Arg | Acc]), Tail}
+ end
+ end.
+
+
+parse_quoted_list(List) ->
+ parse_quoted_list(List, [], false).
+
+parse_quoted_list(<<>>, Acc, false) ->
+ list_to_binary(lists:reverse(Acc));
+parse_quoted_list(<<>>, _, true) ->
+ error;
+parse_quoted_list(<<$\\, $", Rest/binary>>, Acc, Quoted) ->
+ parse_quoted_list(Rest, [$"|Acc], Quoted);
+parse_quoted_list(<<$\s, Rest/binary>>, Acc, false) ->
+ parse_quoted_list(Rest, [0|Acc], false);
+parse_quoted_list(<<$", Rest/binary>>, Acc, false) ->
+ parse_quoted_list(Rest, Acc, true);
+parse_quoted_list(<<$", Rest/binary>>, Acc, true) ->
+ parse_quoted_list(Rest, Acc, false);
+parse_quoted_list(<<H, Rest/binary>>, Acc, Quoted) ->
+ parse_quoted_list(Rest, [H|Acc], Quoted).
+
+reply(Transport, Socket, Message) ->
+ io:format("S: ~s", [list_to_binary(Message)]),
+ Transport:send(Socket, Message).
+
+parse_range(Range) ->
+ parse_range(binstr:split(Range, <<",">>), []).
+
+parse_range([], Acc) ->
+ Acc;
+parse_range([H|T], Acc) ->
+ case binstr:split(H, <<":">>) of
+ [Start, End] ->
+ parse_range(T, lists:seq(binary_to_integer(Start), binary_to_integer(End)) ++ Acc);
+ [Number] ->
+ parse_range(T, [binary_to_integer(Number) | Acc])
+ end.
+
+
+binary_to_integer(Bin) ->
+ list_to_integer(binary_to_list(Bin)).
203 src/imap_parser.peg
@@ -0,0 +1,203 @@
+
+command <- tag space (command_any / command_nonauth / command_auth / command_select) CRLF`
+[Tag, _, Command, _] = Node,
+{Tag, Command}`;
+
+command_any <- ("CAPABILITY" / "LOGOUT" / "NOOP")`
+case Node of
+ <<"CAPABILITY">> -> capability;
+ <<"LOGOUT">> -> logout;
+ <<"NOOP">> -> noop
+end`;
+
+command_nonauth <- (login / authenticate / starttls);
+
+login <- "LOGIN" space username space password`
+[_, _, UserName, _, Password] = Node,
+{login, UserName, Password}`;
+
+username <- astring;
+
+password <- astring;
+
+authenticate <- "AUTHENTICATE" space auth_type`
+[_, _, AuthType] = Node,
+{authenticate, AuthType}`;
+
+auth_type <- atom;
+
+starttls <- "STARTTLS"`
+starttls`;
+
+command_auth <- (append / create / delete / examine / list / lsub / rename / select / status / subscribe / unsubscribe);
+
+append <- "APPEND" space mailbox (space flag_list)* (space date_time) space literal;
+
+create <- "CREATE" space mailbox;
+
+delete <- "DELETE" space mailbox;
+
+examine <- "EXAMINE" space mailbox;
+
+list <- "LIST" space mailbox space list_mailbox;
+
+lsub <- "LSUB" space mailbox space list_mailbox;
+
+rename <- "RENAME" space mailbox space mailbox;
+
+select <- "SELECT" space mailbox;
+
+status <- "STATUS" space mailbox space "(" status_att (space status_att)* ")";
+
+subscribe <- "SUBSCRIBE" space mailbox;
+
+unsubscribe <- "UNSUBSCRIBE" space mailbox;
+
+tag <- (!"+" astring_char)+`
+list_to_binary(lists:flatten(Node))`;
+
+status_att <- ("MESSAGES" / "RECENT" / "UIDNEXT" / "UIDVALIDITY" / "UNSEEN");
+
+list_mailbox <- (list_char / string);
+
+list_char <- (atom_char / list_wildcards / resp_specials);
+
+literal <- "{" number "}";
+
+date_time <- '"' date_day_fixed "-" date_month "-" date_year space time space zone '"';
+
+date_day_fixed <- (" " [0-9] / [1-3] [0-9]);
+
+date_month <- ("Jan" / "Feb" / "Mar" / "Apr" / "May" / "Jun" / "Jul" / "Aug" / "Sep" / "Oct" / "Nov" / "Dec");
+
+date_year <- [0-9] [0-9] [0-9] [0-9];
+
+time <- [0-9] [0-9] ":" [0-9] [0-9] ":" [0-9] [0-9];
+
+zone <- ("+" / "-") [0-9] [0-9] [0-9] [0-9];
+
+command_select <- ("CHECK" / "CLOSE" / "EXPUNGE" / copy / fetch / store / uid / search);
+
+copy <- "COPY" space sequence_set space mailbox;
+
+fetch <- "FETCH" space sequence_set space ("ALL" / "FULL" / "FAST" / fetch_att_list / fetch_att)`
+[_, _, Sequence, _, Att] = Node,
+{fetch, Sequence, Att}`;
+
+fetch_att_list <- "(" fetch_att (space fetch_att)* ")"`
+[_, Element, Elements, _] = Node,
+[Element] ++ lists:map(fun([_, E]) -> E end, Elements)`;
+
+fetch_att <- ("ENVELOPE" / "FLAGS" / "INTERNALDATE" / "RFC822" (".HEADER" / ".SIZE" / ".TEXT")? / "UID" / body_section:("BODY" section ("<" number "." nz_number ">")?) / body_section:("BODY.PEEK" section ("<" number "." nz_number ">")?) / body_structure:("BODY" ".STRUCTURE"?))`
+case Node of
+ {body_section, [B, Sections, []]} ->
+ [B, Sections];
+ {body_section, [B, Sections, [_, Start, _, End, _]]} ->
+ [B, Sections, {Start, End}];
+ {body_structure, L} ->
+ list_to_binary(L);
+ Node -> Node
+end`;
+
+store <- "STORE" space sequence_set space store_att_flags;
+
+store_att_flags <- ("+" / "-")? "FLAGS" ".SILENT"? space flag_list / (flag (space flag)*);
+
+flag <- ('\Answered' / '\Flagged' / '\Deleted' / '\Seen' / '\Draft');
+
+flag_list <- "(" (flag (space flag)*)? ")";
+
+uid <- "UID" space (copy / fetch / search / store);
+
+search <- "SEARCH" (space "CHARSET" space astring) (space search_key)+;
+
+search_key <- "ALL";
+
+section <- "[" section_spec? "]"`
+lists:nth(2, Node)`;
+
+section_spec <- (section_msgtext / section_part_text:(section_part "." section_text) / section_part)`
+case Node of
+ {section_part_text, [Part, _, Text]} ->
+ Part ++ [Text];
+ _ -> Node
+end`;
+
+section_msgtext <- (header_fields:("HEADER.FIELDS" ".NOT"? space header_list) / "HEADER" / "TEXT")`
+case Node of
+ {header_fields, [X, Y, _, List]} ->
+ [list_to_binary([X, Y]), List];
+ _ -> [Node]
+end`;
+
+section_part <- nz_number ("." nz_number)*`
+[Number, Numbers] = Node,
+[Number] ++ lists:map(fun([_, N]) -> N end, Numbers)`;
+
+section_text <- (section_msgtext / "MIME");
+
+header_list <- "(" header_fld_name (space header_fld_name)* ")"`
+[<<"(">>,Element,Elements,<<")">>] = Node,
+[Element] ++ lists:map(fun([_, E]) -> E end, Elements)`;
+
+header_fld_name <- astring;
+
+sequence_set <- (seq_range / seq_number) ("," sequence_set)*`
+[Sequence, Sequences] = Node,
+lists:flatten([Sequence] ++ lists:map(fun([_, E]) -> E end, Sequences))`;
+
+seq_number <- (nz_number / last:"*")`
+case Node of
+ {last, _} -> '*';
+ _ -> Node
+end`;
+
+seq_range <- seq_number ":" seq_number`
+[X, _, Y] = Node,
+{X, Y}`;
+
+space <- " ";
+
+CRLF <- "\r\n";
+
+mailbox <- (inbox / astring);
+
+inbox <- ("I" / "i") ("N" / "n") ("B" / "b") ("O" / "o") ("X" / "x");
+
+astring <- (astring:astring_char+ / string)`
+case Node of
+ {astring, Iolist} ->
+ list_to_binary(lists:flatten(Iolist));
+ _ ->
+ Node
+end`;
+
+
+astring_char <- (atom_char / resp_specials);
+
+%nstring <- (nil / string);
+
+%nil <- "NIL";
+
+number <- [0-9]+`
+list_to_integer(binary_to_list(iolist_to_binary(Node)))`;
+
+nz_number <- [1-9]+ [0-9]*`
+list_to_integer(binary_to_list(iolist_to_binary(Node)))`;
+
+string <- '"' chars:(!'"' ("\\\\" / '\\"' / .))* '"' `iolist_to_binary(proplists:get_value(chars, Node))`;
+
+atom <- atom_char+`
+list_to_binary(Node)`;
+
+atom_char <- (!atom_specials .);
+
+atom_specials <- ("(" / ")" / "{" / " " / ctl / list_wildcards / quoted_specials / resp_specials);
+
+list_wildcards <- ("%" / "*");
+
+quoted_specials <- ("\\\\" / '\\"');
+
+resp_specials <- "]";
+
+ctl <- ("\000" / "\001" / "\002" / "\003" / "\004" / "\005" / "\006" / "\007" / "\b" / "\t" / "\n" / "\v" / "\f" / "\r" / "\016" / "\017" / "\020" / "\021" / "\022" / "\023" / "\024" / "\025" / "\026" / "\027" / "\030" / "\031" / "\032" / "\033" / "\034" / "\035" / "\036" / "\037" / "\177");
57 src/imap_server_example.erl
@@ -0,0 +1,57 @@
+-module(imap_server_example).
+
+-export([init/2, handle_CAPABILITY/2, handle_NOOP/1, handle_LOGOUT/1, handle_LOGIN/3, handle_SELECT/2]).
+
+-record(state, {
+ options,
+ user
+ }).
+
+init(Peername, Options) ->
+ io:format("client connection from ~p~n", [Peername]),
+ {ok, #state{options=Options}}.
+
+handle_CAPABILITY(Capabilities, State) ->
+ %% Add or remove from the capabilities list here
+ {ok, Capabilities ++ ["IDLE"], State}.
+
+handle_NOOP(State) ->
+ {ok, State}.
+
+handle_LOGOUT(State) ->
+ {ok, "Have a super day!", State}.
+
+handle_LOGIN(User, _Pass, State) ->
+ case filelib:is_dir(list_to_binary(["maildir/", User])) of
+ true ->
+ {ok, State#state{user=User}};
+ false ->
+ {error, State}
+ end.
+
+handle_SELECT(inbox, #state{user=User} = State) ->
+ case filelib:wildcard(binary_to_list(list_to_binary(["maildir/", User,"/[Ii][Nn][Bb][Oo][Xx]"]))) of
+ [] ->
+ {error, "No INBOX for this user", State};
+ [Inbox|_] ->
+ %% collect some info about the mailbox
+ {ok, Contents} = file:list_dir(Inbox),
+ Files = [X || X <- Contents, filelib:is_regular(filename:join(Inbox, X))],
+ {ok, {length(Files), 0, 0, ["\\Answered", "\\Flagged", "\\Deleted", "\\Seen", "\\Draft"], [], 5551234, 987654, read_only}, State}
+ end;
+handle_SELECT(Folder, #state{user=User} = State) ->
+ Folder = list_to_binary(["maildir/", User, "/", Folder]),
+ case filelib:is_dir(Folder) of
+ true ->
+ {ok, Contents} = file:list_dir(Folder),
+ Files = [X || X <- Contents, filelib:is_regular(filename:join(Folder, X))],
+ {ok, {length(Files), 0, 0, ["\\Answered", "\\Flagged", "\\Deleted", "\\Seen", "\\Draft"], [], 5551234, 987654, read_only}, State};
+ _ ->
+ {error, "Folder does not exist", State}
+ end.
+
+
+
+
+
+
34 test/imap_parser_test.erl
@@ -0,0 +1,34 @@
+-module(imap_parser_test).
+
+-include_lib("eunit/include/eunit.hrl").
+
+capability_test() ->
+ ?assertEqual({<<"Tag">>, capability}, imap_parser:parse("Tag CAPABILITY\r\n")),
+ ?assertMatch({fail, _}, imap_parser:parse("Tag CAPABILITY illegal arguments\r\n")).
+
+logout_test() ->
+ ?assertEqual({<<"Tag">>, logout}, imap_parser:parse("Tag LOGOUT\r\n")),
+ ?assertMatch({fail, _}, imap_parser:parse("Tag LOGOUT bye bye\r\n")).
+
+noop_test() ->
+ ?assertEqual({<<"Tag">>, noop}, imap_parser:parse("Tag NOOP\r\n")),
+ ?assertMatch({fail, _}, imap_parser:parse("Tag NOOP don't do anything\r\n")).
+
+login_test() ->
+ ?assertEqual({<<"Tag">>, {login, <<"user">>, <<"pass">>}}, imap_parser:parse("Tag LOGIN user pass\r\n")),
+ ?assertMatch({fail, _}, imap_parser:parse("Tag LOGIN \"user name\" \"pass word\"\r\n")).
+
+authenticate_test() ->
+ ?assertEqual({<<"Tag">>, {authenticate, <<"GSSAPI">>}}, imap_parser:parse("Tag AUTHENTICATE GSSAPI\r\n")),
+ ?assertMatch({fail, _}, imap_parser:parse("Tag AUTHENTICATE user pass\r\n")).
+
+starttls_test() ->
+ ?assertEqual({<<"Tag">>, starttls}, imap_parser:parse("Tag STARTTLS\r\n")),
+ ?assertMatch({fail, _}, imap_parser:parse("Tag STARTTLS GSSAPI\r\n")).
+
+parse_fetch_test() ->
+ ?assertEqual({<<"Tag">>, {fetch, [15, 16], <<"BODY">>}}, imap_parser:parse("Tag FETCH 15,16 BODY\r\n")),
+ ?assertEqual({<<"Tag">>, {fetch, [15, 16], [<<"BODY">>, [1, 2, 3]]}}, imap_parser:parse("Tag FETCH 15,16 BODY[1.2.3]\r\n")),
+ ?debugFmt("~p~n", [imap_parser:parse("Tag FETCH 15,16 BODY[1.2.3.HEADER]\r\n")]),
+ ?assertEqual({<<"Tag">>, {fetch, [15, 16], [<<"BODY">>, [1, 2, 3, <<"HEADER">>]]}}, imap_parser:parse("Tag FETCH 15,16 BODY[1.2.3.HEADER]\r\n")),
+ ok.

0 comments on commit b77f9cf

Please sign in to comment.
Something went wrong with that request. Please try again.