1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
module Main where
import Rebase.Prelude
import Options.Applicative (execParser, help, helper, info, long,
metavar, showDefault, strOption, value)
import System.Directory (createDirectoryIfMissing, renameFile)
import System.FilePath (takeFileName, (</>))
import System.FSNotify (Event (..), watchDir, withManager)
import System.Info (os)
import System.IO.Temp (withSystemTempDirectory)
import System.Posix.Files (fileMode, getFileStatus,
intersectFileModes, nullFileMode,
otherReadMode)
import System.Posix.Types (FileMode)
import System.Process.Typed (proc, runProcess)
defaultPdfPrinterExecutable, defaultSpoolDirectory :: FilePath
defaultPdfPrinterExecutable = if os == "linux" then "lp" else "PDFtoPrinter.exe"
defaultSpoolDirectory = if os == "linux" then "/var/spool/cups-pdf/ANONYMOUS" else "."
verbose :: Bool
verbose = True
data Options = Options
{ sendTo :: Maybe String
, pdfPrinterExecutable :: FilePath
, spoolDirectory :: FilePath
}
main :: IO ()
main = execParser (info (options <**> helper) mempty) >>= runReaderT chooseMain
where
options = Options
<$> optional
(strOption $ long "send-to"
<> metavar "RSYNC-DEST"
<> help "Where to send the PDFs via rsync, in rsync target format (host:path)")
<*> (strOption $ long "print-command"
<> metavar "EXECUTABLE"
<> value defaultPdfPrinterExecutable
<> showDefault
<> help "Command to print")
<*> (strOption $ long "spool"
<> metavar "DIRECTORY"
<> value defaultSpoolDirectory
<> showDefault
<> help "Directory where PDFs are received")
chooseMain = asks sendTo >>= maybe serverMain clientMain
getSeenDir :: MonadReader Options m => m FilePath
getSeenDir = asks spoolDirectory <&> (</> "seen")
serverMain :: (MonadReader Options m, MonadIO m) => m ()
serverMain = do
seenDir <- getSeenDir
liftIO $ createDirectoryIfMissing False seenDir
Options{..} <- ask
pr <- pdfPrinter
liftIO $ handlePdfsForever spoolDirectory pr
clientMain :: (MonadReader Options m, MonadIO m) => String -> m ()
clientMain target = do
Options{..} <- ask
liftIO $ handlePdfsForever spoolDirectory (pdfSender target)
pdfPrinter :: MonadReader Options m => m (String -> IO ())
pdfPrinter = do
Options{..} <- ask
seenDir <- getSeenDir
-- Note: there is no sense in checking the return result, as PDFtoPrinter.exe
-- returns success even when it fails to parse the PDF.
return $ \f -> runProcessVerbose pdfPrinterExecutable [f] >> moveFileIntoDir f seenDir
hasMode :: FileMode -> FileMode -> Bool
hasMode = ((.).(.)) (/= nullFileMode) intersectFileModes
newtype Milliseconds = Milliseconds Integer deriving (Num, Show, Eq, Ord)
waitUntil :: (IO Bool) -> Milliseconds -> IO ()
waitUntil cond maxWait = do
r <- cond
when (maxWait > 0 && not r) $ do
threadDelay $ 100 * 1000
waitUntil cond (maxWait - 100)
waitUntilReadable :: FilePath -> Milliseconds -> IO ()
waitUntilReadable f = waitUntil $ hasMode otherReadMode . fileMode <$> getFileStatus f
pdfSender :: String -> FilePath -> IO ()
pdfSender target f = do
withSystemTempDirectory "pdf-autoprint." $ \dir -> do
-- CUPS creates the file (with its final name) and then appends to it,
-- rather than atomically renaming a fully-written file into place. Luckily
-- we can still detect when the file is fully-written because CUPS will
-- change the permissions from 600 to 644 after it is. Thus we poll until
-- the permissions change. This isn't really the best approach; we could use
-- fs notifications here too. We currently do get a 'Modified' event on the
-- file, with which we do nothing. However, I am not sure that this event is
-- not triggered too early.
-- TODO: This doesn't work at all for ~/PDF/ directory where the files are
-- never changed to 644. A completely different approach is necessary! For
-- now, local printing simply will not work.
waitUntilReadable f (100*1000)
-- `PDFToPrinter.exe` will render text on (at least) the IRS tax forms as
-- horrible pixelated smudgy blobs. This `convert` command will render the
-- text into a rasterized PDF that `PDFToPrinter.exe` can handle well.
let converted = dir </> takeFileName f
void $ runProcessVerbose "convert" ["-density", "300", f, converted]
void $ runProcessVerbose "rsync" ["--remove-source-files", converted, target]
handlePdfsForever :: FilePath -> (FilePath -> IO ()) -> IO ()
handlePdfsForever dir h = handleEventsForever dir (handleAdds (".pdf" `isSuffixOf`) h)
handleAdds :: (String -> Bool) -> (FilePath -> IO ()) -> Event -> IO ()
handleAdds predicate handleFile (Added f _ _) | predicate f = handleFile f
handleAdds _ _ x = when verbose $ print x
handleEventsForever :: FilePath -> (Event -> IO ()) -> IO ()
handleEventsForever dir eventHandler = do
withManager $ \mgr -> do
void $ watchDir mgr dir (const True) eventHandler
forever $ threadDelay 1000000
runProcessVerbose :: FilePath -> [String] -> IO ExitCode
runProcessVerbose exe args = do
when verbose $ putStrLn $ "+ " ++ exe ++ " " ++ unwords args
runProcess (proc exe args)
moveFileIntoDir :: FilePath -> FilePath -> IO ()
moveFileIntoDir f d = renameFile f $ d </> takeFileName f
|
