Hello community, here is the log from the commit of package ghc-hdaemonize for openSUSE:Factory checked in at 2017-04-11 09:37:40 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hdaemonize (Old) and /work/SRC/openSUSE:Factory/.ghc-hdaemonize.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-hdaemonize" Tue Apr 11 09:37:40 2017 rev:2 rq:483923 version:0.5.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hdaemonize/ghc-hdaemonize.changes 2017-03-24 01:55:02.158110917 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-hdaemonize.new/ghc-hdaemonize.changes 2017-04-11 09:37:40.984480852 +0200 @@ -1,0 +2,5 @@ +Thu Sep 15 06:38:54 UTC 2016 - psimons@suse.com + +- Update to version 0.5.2 revision 0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- hdaemonize-0.5.0.2.tar.gz New: ---- hdaemonize-0.5.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hdaemonize.spec ++++++ --- /var/tmp/diff_new_pack.i99Pdn/_old 2017-04-11 09:37:41.624390456 +0200 +++ /var/tmp/diff_new_pack.i99Pdn/_new 2017-04-11 09:37:41.628389891 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-hdaemonize # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,15 +18,15 @@ %global pkg_name hdaemonize Name: ghc-%{pkg_name} -Version: 0.5.0.2 +Version: 0.5.2 Release: 0 Summary: Library to handle the details of writing daemons for UNIX License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: +BuildRequires: ghc-bytestring-devel BuildRequires: ghc-extensible-exceptions-devel BuildRequires: ghc-filepath-devel BuildRequires: ghc-hsyslog-devel @@ -34,7 +34,6 @@ BuildRequires: ghc-rpm-macros BuildRequires: ghc-unix-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build -# End cabal-rpm deps %description Provides two functions that help writing better UNIX daemons, daemonize and @@ -56,15 +55,12 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %post devel %ghc_pkg_recache ++++++ hdaemonize-0.5.0.2.tar.gz -> hdaemonize-0.5.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hdaemonize-0.5.0.2/README new/hdaemonize-0.5.2/README --- old/hdaemonize-0.5.0.2/README 2016-05-28 22:41:23.000000000 +0200 +++ new/hdaemonize-0.5.2/README 2016-07-21 21:32:20.000000000 +0200 @@ -1,8 +1,8 @@ -`hdaemonize-0.4.3` +`hdaemonize` ================= `hdaemonize` is a simple library that hides some of the complexities -of writing UNIX daemons in Haskell. +of writing UNIX daemons in Haskell. Obtaining ----------- @@ -42,7 +42,7 @@ # mydaemon start starts the service. A second call to start will complain that the -program is already running. +program is already running. During its execution, mydaemon will simply write a new number to `/tmp/counter` every second, until it reaches 5. Then, an exception @@ -58,7 +58,7 @@ # mydaemon stop # mydaemon restart - + Finally, `mydaemon` drops privileges. By default it changes the effective user and group ids to those of the `daemon` user, but it prefers to use those of `mydaemon`, if present. @@ -67,6 +67,12 @@ Changelog --------- +* 0.5.2 + * Fix pre-AMP builds. + +* 0.5.1 + * Updated to use hsyslog >=4 + * 0.4 * added support for a privileged action before dropping privileges diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hdaemonize-0.5.0.2/System/Posix/Daemonize.hs new/hdaemonize-0.5.2/System/Posix/Daemonize.hs --- old/hdaemonize-0.5.0.2/System/Posix/Daemonize.hs 2016-05-28 22:41:23.000000000 +0200 +++ new/hdaemonize-0.5.2/System/Posix/Daemonize.hs 2016-07-21 21:32:20.000000000 +0200 @@ -1,13 +1,15 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} module System.Posix.Daemonize ( -- * Simple daemonization - daemonize, + daemonize, -- * Building system services serviced, CreateDaemon(..), simpleDaemon, - -- * Intradaemon utilities + -- * Intradaemon utilities fatalError, exitCleanly - -- * An example - -- + -- * An example + -- -- | Here is an example of a full program which writes a message to -- syslog once a second proclaiming its continued existance, and -- which installs its own SIGHUP handler. Note that you won't @@ -15,33 +17,34 @@ -- systems. @syslogd@ detects repeated messages and prints the -- first one, then delays for the rest and eventually writes a line -- about how many times it has seen it. - -- + -- + -- > {-# LANGUAGE OverloadedStrings #-} -- > module Main where -- > -- > import System.Posix.Daemonize (CreateDaemon(..), serviced, simpleDaemon) -- > import System.Posix.Signals (installHandler, Handler(Catch), sigHUP, fullSignalSet) - -- > import System.Posix.Syslog (syslog, Priority(Notice)) + -- > import System.Posix.Syslog (syslogUnsafe, Facility(DAEMON), Priority(Notice)) -- > import Control.Concurrent (threadDelay) -- > import Control.Monad (forever) - -- > + -- > -- > main :: IO () -- > main = serviced stillAlive - -- > + -- > -- > stillAlive :: CreateDaemon () -- > stillAlive = simpleDaemon { program = stillAliveMain } - -- > + -- > -- > stillAliveMain :: () -> IO () -- > stillAliveMain _ = do -- > installHandler sigHUP (Catch taunt) (Just fullSignalSet) -- > forever $ do threadDelay (10^6) - -- > syslog Notice "I'm still alive!" - -- > + -- > syslog DAEMON Notice "I'm still alive!" + -- > -- > taunt :: IO () - -- > taunt = syslog Notice "I sneeze in your general direction, you and your SIGHUP." + -- > taunt = syslogUnsafe DAEMON Notice "I sneeze in your general direction, you and your SIGHUP." ) where - -{- originally based on code from + +{- originally based on code from http://sneakymustard.com/2008/12/11/haskell-daemons -} @@ -56,13 +59,21 @@ import Prelude hiding (catch) #endif +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<$), (<$>)) +#endif + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as ByteString +import Data.Maybe (isNothing, fromMaybe, fromJust) import System.Environment import System.Exit import System.Posix -import System.Posix.Syslog (withSyslog,Option(..),Priority(..),Facility(..),syslog) +import System.Posix.Syslog (withSyslog,SyslogConfig(..),Option(..),Priority(..),PriorityMask(..),Facility(..),syslogUnsafe) import System.FilePath.Posix (joinPath) -import Data.Maybe (isNothing, fromMaybe, fromJust) +syslog :: Priority -> ByteString -> IO () +syslog = syslogUnsafe DAEMON -- | Turning a process into a daemon involves a fixed set of -- operations on unix systems, described in section 13.3 of Stevens @@ -70,36 +81,32 @@ -- they are fixed, they can be written as a single function, -- 'daemonize' taking an 'IO' action which represents the daemon's -- actual activity. --- +-- -- Briefly, 'daemonize' sets the file creation mask to 0, forks twice, -- changed the working directory to @/@, closes stdin, stdout, and -- stderr, blocks 'sigHUP', and runs its argument. Strictly, it -- should close all open file descriptors, but this is not possible in -- a sensible way in Haskell. --- +-- -- The most trivial daemon would be --- +-- -- > daemonize (forever $ return ()) --- +-- -- which does nothing until killed. -daemonize :: IO () -> IO () -daemonize program = - - do setFileCreationMask 0 - forkProcess p - exitImmediately ExitSuccess - +daemonize :: IO () -> IO () +daemonize program = do + setFileCreationMask 0 + forkProcess p + exitImmediately ExitSuccess where - p = do createSession forkProcess p' exitImmediately ExitSuccess - p' = do changeWorkingDirectory "/" closeFileDescriptors blockSignal sigHUP - program + program @@ -107,9 +114,9 @@ -- | 'serviced' turns a program into a UNIX daemon (system service) -- ready to be deployed to /etc/rc.d or similar startup folder. It -- is meant to be used in the @main@ function of a program, such as --- +-- -- > serviced simpleDaemon --- +-- -- The resulting program takes one of three arguments: @start@, -- @stop@, and @restart@. All control the status of a daemon by -- looking for a file containing a text string holding the PID of @@ -125,9 +132,9 @@ -- written therein. First it does a soft kill, SIGTERM, giving the -- daemon a chance to shut down cleanly, then three seconds later a -- hard kill which the daemon cannot catch or escape. --- +-- -- @restart@ is simple @stop@ followed by @start@. --- +-- -- 'serviced' also tries to drop privileges. If you don't specify a -- user the daemon should run as, it will try to switch to a user -- with the same name as the daemon, and otherwise to user @daemon@. @@ -135,44 +142,40 @@ -- matters, the name of the daemon is by default the name of the -- executable file, but can again be set to something else in the -- 'CreateDaemon' record. --- +-- -- Finally, exceptions in the program are caught, logged to syslog, -- and the program restarted. serviced :: CreateDaemon a -> IO () -serviced daemon = do - systemName <- getProgName - let daemon' = daemon { name = if isNothing (name daemon) - then Just systemName else name daemon } - args <- getArgs - process daemon' args +serviced daemon = do + systemName <- getProgName + let daemon' = daemon { name = if isNothing (name daemon) + then Just systemName else name daemon } + args <- getArgs + process daemon' args where -#if MIN_VERSION_hsyslog(2,0,0) - program' daemon = withSyslog (fromJust $ name daemon) (syslogOptions daemon) DAEMON [] $ -#else - program' daemon = withSyslog (fromJust $ name daemon) (syslogOptions daemon) DAEMON $ -#endif + program' daemon = withSyslog (SyslogConfig (ByteString.pack $ fromJust $ name daemon) (syslogOptions daemon) DAEMON NoMask) $ \_ -> do let log = syslog Notice log "starting" pidWrite daemon privVal <- privilegedAction daemon dropPrivileges daemon - forever $ program daemon $ privVal + forever $ program daemon privVal process daemon ["start"] = pidExists daemon >>= f where f True = do error "PID file exists. Process already running?" exitImmediately (ExitFailure 1) f False = daemonize (program' daemon) - - process daemon ["stop"] = + + process daemon ["stop"] = do pid <- pidRead daemon case pid of Nothing -> pass - Just pid -> - (do whenM (pidLive pid) $ - do signalProcess sigTERM pid - usleep (10^3) - wait (killWait daemon) pid) + Just pid -> + whenM (pidLive pid) + (do signalProcess sigTERM pid + usleep (10^3) + wait (killWait daemon) pid) `finally` removeLink (pidFile daemon) @@ -183,13 +186,13 @@ f True = do pid <- pidRead daemon case pid of - Nothing -> putStrLn $ (fromJust $ name daemon) ++ " is not running." + Nothing -> putStrLn $ fromJust (name daemon) ++ " is not running." Just pid -> do res <- pidLive pid if res then - do putStrLn $ (fromJust $ name daemon) ++ " is running." - else putStrLn $ (fromJust $ name daemon) ++ " is not running, but pidfile is remaining." - f False = putStrLn $ (fromJust $ name daemon) ++ " is not running." + putStrLn $ fromJust (name daemon) ++ " is running." + else putStrLn $ fromJust (name daemon) ++ " is not running, but pidfile is remaining." + f False = putStrLn $ fromJust (name daemon) ++ " is not running." process _ _ = getProgName >>= \pname -> putStrLn $ "usage: " ++ pname ++ " {start|stop|status|restart}" @@ -254,8 +257,8 @@ -- wait forever. Default 4. } --- | The simplest possible instance of 'CreateDaemon' is --- +-- | The simplest possible instance of 'CreateDaemon' is +-- -- > CreateDaemon { -- > privilegedAction = return () -- > program = const $ forever $ return () @@ -265,7 +268,7 @@ -- > syslogOptions = [], -- > pidfileDirectory = Nothing, -- > } --- +-- -- which does nothing forever with all default settings. We give it a -- name, 'simpleDaemon', since you may want to use it as a template -- and modify only the fields that you need. @@ -281,58 +284,60 @@ privilegedAction = return (), killWait = Just 4 } - + {- implementation -} forever :: IO () -> IO () -forever program = +forever program = program `catch` restart where - restart :: SomeException -> IO () - restart e = - do syslog Error ("unexpected exception: " ++ show e) + restart :: SomeException -> IO () + restart e = + do syslog Error $ ByteString.pack ("unexpected exception: " ++ show e) syslog Error "restarting in 5 seconds" usleep (5 * 10^6) forever program closeFileDescriptors :: IO () -closeFileDescriptors = +closeFileDescriptors = do null <- openFd "/dev/null" ReadWrite Nothing defaultFileFlags let sendTo fd' fd = closeFd fd >> dupTo fd' fd - mapM_ (sendTo null) $ [stdInput, stdOutput, stdError] + mapM_ (sendTo null) [stdInput, stdOutput, stdError] -blockSignal :: Signal -> IO () +blockSignal :: Signal -> IO () blockSignal sig = installHandler sig Ignore Nothing >> pass getGroupID :: String -> IO (Maybe GroupID) -getGroupID group = - try (fmap groupID (getGroupEntryForName group)) >>= return . f where +getGroupID group = + f <$> try (fmap groupID (getGroupEntryForName group)) + where f :: Either IOException GroupID -> Maybe GroupID f (Left _) = Nothing f (Right gid) = Just gid getUserID :: String -> IO (Maybe UserID) -getUserID user = - try (fmap userID (getUserEntryForName user)) >>= return . f where +getUserID user = + f <$> try (fmap userID (getUserEntryForName user)) + where f :: Either IOException UserID -> Maybe UserID f (Left _) = Nothing f (Right uid) = Just uid dropPrivileges :: CreateDaemon a -> IO () -dropPrivileges daemon = +dropPrivileges daemon = do Just ud <- getUserID "daemon" Just gd <- getGroupID "daemon" let targetUser = fromMaybe (fromJust $ name daemon) (user daemon) targetGroup = fromMaybe (fromJust $ name daemon) (group daemon) - u <- fmap (maybe ud id) $ getUserID targetUser - g <- fmap (maybe gd id) $ getGroupID targetGroup - setGroupID g + u <- fromMaybe ud <$> getUserID targetUser + g <- fromMaybe gd <$> getGroupID targetGroup + setGroupID g setUserID u pidFile:: CreateDaemon a -> String -pidFile daemon = joinPath [dir, (fromJust $ name daemon) ++ ".pid"] +pidFile daemon = joinPath [dir, fromJust (name daemon) ++ ".pid"] where dir = fromMaybe "/var/run" (pidfileDirectory daemon) pidExists :: CreateDaemon a -> IO Bool @@ -340,7 +345,7 @@ pidRead :: CreateDaemon a -> IO (Maybe CPid) pidRead daemon = pidExists daemon >>= choose where - choose True = fmap (Just . read) $ readFile (pidFile daemon) + choose True = return . read <$> readFile (pidFile daemon) choose False = return Nothing pidWrite :: CreateDaemon a -> IO () @@ -349,12 +354,12 @@ writeFile (pidFile daemon) (show pid) pidLive :: CPid -> IO Bool -pidLive pid = +pidLive pid = (getProcessPriority pid >> return True) `catch` f where f :: IOException -> IO Bool f _ = return False - -pass :: IO () + +pass :: IO () pass = return () -- | When you encounter an error where the only sane way to handle it @@ -363,7 +368,7 @@ -- configuration files on startup. fatalError :: MonadIO m => String -> m a fatalError msg = liftIO $ do - syslog Error $ "Terminating from error: " ++ msg + syslog Error $ ByteString.pack $ "Terminating from error: " ++ msg exitImmediately (ExitFailure 1) undefined -- You will never reach this; it's there to make the type checker happy diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hdaemonize-0.5.0.2/hdaemonize.cabal new/hdaemonize-0.5.2/hdaemonize.cabal --- old/hdaemonize-0.5.0.2/hdaemonize.cabal 2016-05-28 22:41:23.000000000 +0200 +++ new/hdaemonize-0.5.2/hdaemonize.cabal 2016-07-21 21:32:20.000000000 +0200 @@ -1,5 +1,5 @@ Name: hdaemonize -Version: 0.5.0.2 +Version: 0.5.2 Cabal-Version: >= 1.6 License: BSD3 License-file: LICENSE @@ -18,15 +18,14 @@ Library Build-Depends: base >= 4 && < 5 + , bytestring , unix - , hsyslog < 3 + , hsyslog >= 4 , extensible-exceptions , filepath , mtl Exposed-modules: System.Posix.Daemonize - Extensions: CPP if impl(ghc > 6.12) Ghc-Options: -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-name-shadowing else Ghc-Options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing -