
> module Main (main) where

> import IO
> import Maybe
> import Exception
> import Posix
> import System
> import GetOpt
> import MD5

> data Flag = Verbose | Binary {- not implemented -} | Check String
>           | Test deriving Eq


main works out what need to be done and calls the appropriate function
to do it

> main :: IO()
> main = do args <- System.getArgs
>           (opts, files) <- md5sum_opts args
>           if or $ map ((==) Test) opts
>            then md5test
>            else case is_check opts of
>                     Nothing
>                         -> if files == []
>                            then do c <- getContents
>                                    putStr $ md5s (Str c)
>                                    putStr "\n"
>                            else foldr (\x y -> md5_file x >> y)
>                                     (return ()) files
>                     Just fn -> check (is_verbose opts) fn


Read everything from stdin and return it

> read_data :: Fd -> IO (Fd, String)
> read_data fh = do maybeData <- tryAllIO $ fdRead fh 1024
>                   case maybeData of
>                       Left _ -> return (fh, "")
>                       Right (this, _) -> return (fh, this)


MD5 a file and print the result

> md5_file :: String -> IO()
> md5_file file = do maybe_content <- tryAllIO $ readFile file
>                    maybe_fs <- tryAllIO $ getFileStatus file
>                    case (maybe_content, maybe_fs) of
>                        (Right content, Right _) ->
>                            do putStr (md5s (Str content))
>                               putStr "  "
>                               putStr file
>                               putStr "\n"
>                        (_, Left _) ->
>                            do putErr file
>                               putErr ": No such file or directory.\n"
>                        (Left _, _) ->
>                            do ec <- getErrorCode
>                               if ec == permissionDenied
>                                then do putErr file
>                                        putErr ": Permission denied\n"
>                                else do putErr "md5sum: error reading "
>                                        putErr file
>                                        putErr "\n"


Run the test suite

> md5test :: IO()
> md5test = foldr f (return ()) l
>  where f (str, hash) so_far
>         = do putStr "Doing "
>              putStr (show str)
>              putStr "\n"
>              putStr "Should be "
>              putStr hash      
>              putStr "\n"
>              putStr "Got       "
>              putStr (md5s (Str str))
>              putStr "\n\n"
>              so_far
>        l = [("", "d41d8cd98f00b204e9800998ecf8427e"),
>             ("a", "0cc175b9c0f1b6a831c399e269772661"),
>             ("abc", "900150983cd24fb0d6963f7d28e17f72"),
>             ("message digest", "f96b697d7cb7938d525a2f31aaf161d0"),
>             ("abcdefghijklmnopqrstuvwxyz",
>              "c3fcd3d76192e4007dfb496cca67e13b"),
>             ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789",
>              "d174ab98d277d9f5a5611c2c9f419d9f"),
>             ("12345678901234567890123456789012345678901234567890123456789012345678901234567890",
>              "57edf4a22be3c955ac49da2e2107b67a")]

> monad_test :: (Int, String) -> IO ((Int, String), String)
> monad_test (0, s) = return ((1, s), s)
> monad_test e = return (e, "")

Given a file with a list of checksums, check all the checksums

> check :: Bool -> String -> IO()
> check v f =
>  do maybe_l <- tryAllIO $ get_list f
>     case maybe_l of
>          Left _ ->
>              do ec <- getErrorCode
>                 if ec == permissionDenied
>                  then putErr f >> putErr ": Permission denied\n"
>                  else putErr f >> putErr ": No such file or directory\n"
>          Right l ->
>              do (_, number, broken)
>                     <- foldl (checkhash v) (return (15, 0, 0)) l
>                 if v && broken > 0 then do putErr "md5sum: "
>                                            putErr (show broken)
>                                            putErr " of "
>                                            putErr (show number)
>                                            putErr " file(s) fail MD5 check\n"
>                                    else return ()


Given a (hash, file) tuple, check the hash is correct for that file and
update the longest length so far and counts

> checkhash :: Bool -> IO (Int, Int, Int) -> (String, String)
>                                            -> IO (Int, Int, Int)
> checkhash v io_l_n_b (h, f) =
>  do (len, number, broken) <- io_l_n_b
>     maybe_content <- tryAllIO $ readFile f
>     let len' = if length f >= len - 1 then length f + 1
>                                       else len
>     let io_fn = putErr f >> putErr (replicate (len' - length f) ' ')
>     case maybe_content of
>         Right content ->
>             let h' = md5s (Str content) in
>             if h == h'
>              then if v
>                   then do _ <- io_fn >> putErr "OK\n"
>                           return (len', number + 1, broken)
>                   else return (len', number + 1, broken)
>              else do _ <- if v
>                            then io_fn >> putErr "FAILED\n"
>                            else do putErr "md5sum: MD5 check failed for '"
>                                    putErr f
>                                    putErr "'\n"
>                      return (len', number + 1, broken + 1)
>         _ -> do if v then io_fn >> putErr "md5sum: Can't open "
>                      else          putErr "md5sum: Can't open "
>                 putErr f
>                 putErr "\n"
>                 return (len', number, broken)


Given a filename for checking, get the list of hash, filename tuples

> get_list :: String -> IO [(String, String)]
> get_list f = do h <- openFile f ReadMode
>                 let content = parse h
>                 {- hClose h -}
>                 content


Do the work for the above

> parse :: Handle -> IO [(String, String)]
> parse h = do eof <- hIsEOF h
>              if eof
>               then return []
>               else do line <- hGetLine h
>                       rest <- parse h
>                       let hash = take 32 line
>                       let filename = drop 34 line
>                       if filename /= "" && is_hash hash
>                        then return $ (hash, filename):rest
>                        else return rest


If the String is a valid hash (the length is assumed to be correct)
return True, else False

> is_hash :: String -> Bool
> is_hash ""  = True
> is_hash (c:cs) = if (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f')
>                  then is_hash cs
>                  else False


putStr for errors

> putErr :: String -> IO()
> putErr = hPutStr stderr


===== Options =====

> options :: [OptDescr Flag]
> options =
>  [Option ['c'] [] (ReqArg Check "Check") "check message digests (default is generate)",
>   Option ['v'] [] (NoArg Verbose) "verbose, print file names when checking",
>   Option ['b'] [] (NoArg Binary) "(ignored)",
>   Option ['t'] [] (NoArg Test)    "test the code is functioning correctly"]

> md5sum_opts :: [String] -> IO ([Flag], [String])
> md5sum_opts argv =
>   case (getOpt Permute options argv) of
>      (o,n,[]  ) -> return (o,n)
>      (_,_,errs) -> fail (concat errs ++ usageInfo header options ++ footer)
>  where header = "usage: md5sum [-btv] [-c [file]] | [file...]\nGenerates or checks MD5 Message Digests"
>        footer = "The input for -c should be the list of message digests and file names\nthat is printed on stdout by this program when it generates digests."

> is_check :: [Flag] -> Maybe String
> is_check [] = Nothing
> is_check (Check s:_) = Just s
> is_check (_:os) = is_check os

> is_verbose :: [Flag] -> Bool
> is_verbose = foldr (\x y -> if x == Verbose then True else y) False

