cleanup old commits, and use dotlock on symlink

1 files changed, 23 insertions, 13 deletions

diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 4c9f98c..9fb71be 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Kiki where
 
+import Control.Exception
 import Control.Applicative
 import Control.Arrow
 import Control.Monad
@@ -19,9 +20,11 @@ import System.Directory
 import System.FilePath.Posix
 import System.IO
 import System.IO.Temp
+import System.IO.Error
 import System.Posix.User
 import System.Process
 import System.Posix.Files
+import qualified Data.Traversable as T (mapM)
 import qualified Codec.Binary.Base64 as Base64
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as Char8
@@ -30,6 +33,7 @@ import qualified SSHKey as SSH
 
 import CommandLine
 import KeyRing
+import DotLock
 
 -- |
 -- Regenerate /var/cache/kiki
@@ -215,19 +219,25 @@ refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO ()
 refreshCache rt rootdir = do
 
     let getMkPathAndCommit destdir = do
-        let cachedir = takeDirectory destdir
-            unslash ('/':xs) = xs
-            unslash xs = xs
-        createDirectoryIfMissing True cachedir
-        tmpdir <- createTempDirectory cachedir ("transaction." ++ takeBaseName destdir)
-        createSymbolicLink tmpdir (tmpdir ++ ".link")
-        let mkpath pth = tmpdir </> unslash pth
-            commit     = do
-                -- oldcommit <- readSymbolicLink destdir
-                rename (tmpdir ++ ".link") destdir
-                -- FIXME: somehow cleanup old commits
-                -- removeDirectoryRecursive oldcommit
-        return (mkpath,commit)
+            let cachedir = takeDirectory destdir
+                unslash ('/':xs) = xs
+                unslash xs = xs
+                timeout = -1 -- TODO: set milisecond timeout on dotlock
+            createDirectoryIfMissing True cachedir
+            tmpdir <- createTempDirectory cachedir ("transaction." ++ takeBaseName destdir)
+            createSymbolicLink tmpdir (tmpdir ++ ".link")
+            lock <- dotlock_create destdir 0
+            T.mapM (flip dotlock_take timeout) lock
+            let mkpath pth = tmpdir </> unslash pth
+                commit     = do
+                    oldcommit <- (Just <$> readSymbolicLink destdir)
+                                    `catch` \e -> do
+                                        when (not $ isDoesNotExistError e) $ warn (show e)
+                                        return Nothing
+                    rename (tmpdir ++ ".link") destdir
+                    er <- T.mapM dotlock_release lock
+                    void $ T.mapM removeDirectoryRecursive oldcommit
+            return (mkpath,commit)
     (mkpath, commit) <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config")
 
     let write' wr f bs = do