fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor(lpr): minor code cleaning after testing

Browse Source
This commit is contained in:
Steffen Jost 2022-08-15 16:18:09 +02:00
parent 5e7b511eb2
commit 839b126c6a
1 changed files with 33 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
src/Utils/Print.hs
View File

@ -277,13 +277,21 @@ sendLetter' printJobName pdf printJobRecipient printJobSender printJobCourse pri
----------------------------- -----------------------------
-- | Converts Triple consisting of @ExitCode@, Success- and Failure-Value to Either Failue- or Success-Value. -- | Converts Triple consisting of @ExitCode@, Success- and Failure-Value to Either Failue- or Success-Value.
-- Returns @Right@ if the @ExitCode@ is @ExitsSuccess, entirely ignoring the Failure-Value, which ususally might contain warning messages. -- Returns @Right@ if the @ExitCode@ is @ExitsSuccess, entirely ignoring the Failure-Value, which might contain warning messages.
-- To be used with 'System.Process.Typed.readProcess' -- To be used with 'System.Process.Typed.readProcess'
exit2either :: (ExitCode, a, b) -> Either b a exit2either :: (ExitCode, a, b) -> Either b a
exit2either (ExitSuccess , ok, _) = Right ok -- warnings are ignored here! exit2either (ExitSuccess , ok, _) = Right ok -- warnings are ignored here!
exit2either (ExitFailure _ , _, err) = Left err exit2either (ExitFailure _ , _, err) = Left err
readProcess' :: MonadIO m => ProcessConfig stdin stdoutIgnored stderrIgnored -> m (ExitCode, Text, Text)
readProcess' pc = do
(ec, bs_err, bs_out) <- readProcess pc
let st_err = decodeUtf8 $ LBS.toStrict bs_err
st_out = decodeUtf8 $ LBS.toStrict bs_out
return (ec, st_err, st_out)
----------- -----------
-- pdftk -- -- pdftk --
@ -310,16 +318,36 @@ encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> read
-- Use the keyword PROMPT to supply a password via standard input instead. -- Use the keyword PROMPT to supply a password via standard input instead.
--------- ---------
-- lpr -- -- lpr --
--------- ---------
-- --
-- We use the external tool lpr in the variant supplied by busybox -- We use the external tool lpr in the variant supplied by busybox
-- to print pdfs like so: -- to print pdfs like so:
-- > lpr -P fradrive@fravm017173.fra.fraport.de -J printJobName - -- > lpr -P fradrive@fravm017173.fra.fraport.de:515 -J printJobName -
-- --
-- The cups version of lpr is instead used like so:
-- > lpr -P fradrive -H fravm017173.fra.fraport.de:515 -T printJobName -
lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => String -> LBS.ByteString -> m (Either Text Text)
lprPDF jb bs = do
lprServerArg <- $cachedHereBinary ("lprServer"::Text) getLprServerArg
let pc = setStdin (byteStringInput bs) $
proc "lpr" $
jobname ++ -- -J jobname -- a name for job identification at printing site
[ lprServerArg -- -P queue@hostname:port
, "-" -- read from stdin
]
jobname | null jb = []
| otherwise = ["-J " <> jb]
exit2either <$> readProcess' pc
where
getLprServerArg = do
LprConf{..} <- getsYesod $ view _appLprConf
return $ "-P " <> lprQueue <> "@" <> lprHost <> ":" <> show lprPort
{- -- Variant without caching
lprPDF' :: (MonadHandler m, HasAppSettings (HandlerSite m)) => String -> LBS.ByteString -> m (Either Text Text) lprPDF' :: (MonadHandler m, HasAppSettings (HandlerSite m)) => String -> LBS.ByteString -> m (Either Text Text)
lprPDF' jb bs = do lprPDF' jb bs = do
LprConf{..} <- getsYesod $ view _appLprConf LprConf{..} <- getsYesod $ view _appLprConf
@ -331,21 +359,5 @@ lprPDF' jb bs = do
] ]
jobname | null jb = [] jobname | null jb = []
| otherwise = ["-J " <> jb] | otherwise = ["-J " <> jb]
over _Left (decodeUtf8 . LBS.toStrict) . over _Right (decodeUtf8 . LBS.toStrict) . exit2either <$> readProcess pc exit2either <$> readProcess' pc
-}
lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => String -> LBS.ByteString -> m (Either Text Text)
lprPDF jb bs = do
lprServerArg <- $cachedHereBinary ("lprServer"::Text) getLprServerArg
let pc = setStdin (byteStringInput bs) $
proc "lpr" $ jobname ++ -- -J jobname -- a name for job identification at printing site
[ lprServerArg -- -P queue@hostname:port
, "-" -- read from stdin
]
jobname | null jb = []
| otherwise = ["-J " <> jb]
over _Left (decodeUtf8 . LBS.toStrict) . over _Right (decodeUtf8 . LBS.toStrict) . exit2either <$> readProcess pc
where
getLprServerArg = do
LprConf{..} <- getsYesod $ view _appLprConf
return $ "-P " <> lprQueue <> "@" <> lprHost <> ":" <> show lprPort