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

chore(lpr): make lpr settings configurable via env or yml

Browse Source
This commit is contained in:
Steffen Jost 2022-08-15 14:07:16 +02:00
parent f9f5e0cd65
commit 5e7b511eb2
3 changed files with 50 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
config/settings.yml
View File

@ -131,6 +131,11 @@ avs:
user: "_env:AVSUSER:fradrive"
pass: "_env:AVSPASS:"
lpr:
host: "_env:LPRHOST:fravm017173.fra.fraport.de"
port: "_env:LPRPORT:515"
queue: "_env:LPRQUEUE:fradrive"
smtp:
host: "_env:SMTPHOST:"
port: "_env:SMTPPORT:25"

16
src/Settings.hs
View File

@ -96,6 +96,8 @@ data AppSettings = AppSettings
-- ^ Configuration settings for accessing the LDAP-directory
, appAvsConf :: Maybe AvsConf
-- ^ Configuration settings for accessing AVS Server (= Ausweis Verwaltungs System)
, appLprConf :: LprConf
-- ^ Configuration settings for accessing a printer queue via lpr for letter mailing
, appSmtpConf :: Maybe SmtpConf
-- ^ Configuration settings for accessing a SMTP Mailserver
, appWidgetMemcachedConf :: Maybe WidgetMemcachedConf
@ -306,6 +308,12 @@ data AvsConf = AvsConf
, avsPass :: ByteString
} deriving (Show)
data LprConf = LprConf
{ lprHost :: String
, lprPort :: Int
, lprQueue:: String
} deriving (Show)
data SmtpConf = SmtpConf
{ smtpHost :: HaskellNet.HostName
, smtpPort :: HaskellNet.PortNumber
@ -480,6 +488,13 @@ instance FromJSON AvsConf where
avsPass <- o .:? "pass" .!= ""
return AvsConf{..}
instance FromJSON LprConf where
parseJSON = withObject "LprConf" $ \o -> do
lprHost <- o .: "host"
lprPort <- o .: "port"
lprQueue <- o .: "queue"
return LprConf{..}
instance FromJSON SmtpConf where
parseJSON = withObject "SmtpConf" $ \o -> do
smtpHost <- o .:? "host" .!= ""
@ -562,6 +577,7 @@ instance FromJSON AppSettings where
Ldap.Plain host -> not $ null host
appLdapConf <- P.fromList . mapMaybe (assertM nonEmptyHost) <$> o .:? "ldap" .!= []
appAvsConf <- assertM (not . null . avsPass) <$> o .:? "avs"
appLprConf <- o .: "lpr"
appSmtpConf <- assertM (not . null . smtpHost) <$> o .:? "smtp"
let validMemcachedConf MemcachedConf{memcachedConnectInfo = Memcached.ConnectInfo{..}} = and
[ not $ null connectHost

40
src/Utils/Print.hs
View File

@ -320,14 +320,32 @@ encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> read
-- > lpr -P fradrive@fravm017173.fra.fraport.de -J printJobName -
--
lprPDF :: MonadIO m => String -> LBS.ByteString -> m (Either Text Text)
lprPDF jb bs = over _Left (decodeUtf8 . LBS.toStrict) .
over _Right (decodeUtf8 . LBS.toStrict) . exit2either <$> readProcess pc
where
pc = setStdin (byteStringInput bs) $
proc "lpr" $ [ "-P fradrive@fravm017173.fra.fraport.de:515" -- queue@hostname:port TODO: turn this into a setting
] ++ jobname ++ -- a name for job identification at printing site
[ "-" -- read from stdin
]
jobname | null jb = []
| otherwise = ["-J", jb]
lprPDF' :: (MonadHandler m, HasAppSettings (HandlerSite m)) => String -> LBS.ByteString -> m (Either Text Text)
lprPDF' jb bs = do
LprConf{..} <- getsYesod $ view _appLprConf
let lprServer = lprQueue <> "@" <> lprHost <> ":" <> show lprPort
pc = setStdin (byteStringInput bs) $
proc "lpr" $ [ "-P " <> lprServer -- queue@hostname:port
] ++ jobname ++ -- a name for job identification at printing site
[ "-" -- read from stdin
]
jobname | null jb = []
| otherwise = ["-J " <> jb]
over _Left (decodeUtf8 . LBS.toStrict) . over _Right (decodeUtf8 . LBS.toStrict) . 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