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

config/settings.yml

@@ -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"

src/Settings.hs

@@ -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

src/Utils/Print.hs

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