X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/7a9616824f3478c4ba5eec100692e277e23243ab..dee1a22babf7a1eb1c938f716dc37ced3abfd4e4:/src/mail/vmail.sml diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml index 60a3a35..cf36f9f 100644 --- a/src/mail/vmail.sml +++ b/src/mail/vmail.sml @@ -28,33 +28,41 @@ datatype listing = fun list domain = let - val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir, - file = domain}) - - fun loop users = - case TextIO.inputLine inf of - NONE => Listing (rev users) - | SOME line => - case String.tokens Char.isSpace line of - [addr, fields] => - (case String.fields (fn ch => ch = #"@") addr of - [user, _] => - let - fun parseFields fields = - case fields of - "mail" :: mailbox :: _ => loop ({user = user, mailbox = mailbox} :: users) - | _ :: _ :: rest => parseFields rest - | _ => Error "Invalid fields in database" - in - parseFields (String.fields (fn ch => ch = #"|" orelse ch = #"=") fields) - end - | _ => Error "Invalid e-mail address format in database") - | _ => Error "Invalid entry in database" + val file = OS.Path.joinDirFile {dir = Config.Courier.userdbDir, + file = domain} in - loop [] - before TextIO.closeIn inf + if Posix.FileSys.access (file, []) then + let + val inf = TextIO.openIn file + + fun loop users = + case TextIO.inputLine inf of + NONE => Listing (rev users) + | SOME line => + case String.tokens Char.isSpace line of + [addr, fields] => + (case String.fields (fn ch => ch = #"@") addr of + [user, _] => + let + fun parseFields fields = + case fields of + "mail" :: mailbox :: _ => loop ({user = user, mailbox = mailbox} :: users) + | _ :: _ :: rest => parseFields rest + | _ => Error "Invalid fields in database" + in + parseFields (String.fields (fn ch => ch = #"|" orelse ch = #"=") fields) + end + | _ => Error "Invalid e-mail address format in database") + | _ => Error "Invalid entry in database" + in + loop [] + before TextIO.closeIn inf + end + else + Listing [] end - handle IO.Io _ => Listing [] + handle IO.Io {name, function, ...} => + Error ("IO failure: " ^ name ^ ": " ^ function) fun mailboxExists {domain, user} = let