Now uses the Haskell uuid library, rather than needing a uuid program.
Been meaning to do this for some time; Android port was last straw. Note that newer versions of the uuid library have a Data.UUID.V4 that generates random UUIDs slightly more cleanly, but Debian has an old version of the library, so I do it slightly round-about.
This commit is contained in:
parent
8e591d50fd
commit
f202d997f4
7 changed files with 15 additions and 14 deletions
|
@ -6,7 +6,7 @@
|
||||||
- UUIDs of remotes are cached in git config, using keys named
|
- UUIDs of remotes are cached in git config, using keys named
|
||||||
- remote.<name>.annex-uuid
|
- remote.<name>.annex-uuid
|
||||||
-
|
-
|
||||||
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
|
- Copyright 2010-2013 Joey Hess <joey@kitenet.net>
|
||||||
-
|
-
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
@ -24,20 +24,17 @@ module Annex.UUID (
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.Config
|
import qualified Git.Config
|
||||||
import qualified Build.SysConfig as SysConfig
|
|
||||||
import Config
|
import Config
|
||||||
|
|
||||||
|
import qualified Data.UUID as U
|
||||||
|
import System.Random
|
||||||
|
|
||||||
configkey :: ConfigKey
|
configkey :: ConfigKey
|
||||||
configkey = annexConfig "uuid"
|
configkey = annexConfig "uuid"
|
||||||
|
|
||||||
{- Generates a UUID. There is a library for this, but it's not packaged,
|
{- Generates a random UUID, that does not include the MAC address. -}
|
||||||
- so use the command line tool. -}
|
|
||||||
genUUID :: IO UUID
|
genUUID :: IO UUID
|
||||||
genUUID = gen . lines <$> readProcess command params
|
genUUID = UUID . show <$> (randomIO :: IO U.UUID)
|
||||||
where
|
|
||||||
gen [] = error $ "no output from " ++ command
|
|
||||||
gen (l:_) = toUUID l
|
|
||||||
(command:params) = words SysConfig.uuid
|
|
||||||
|
|
||||||
{- Get current repository's UUID. -}
|
{- Get current repository's UUID. -}
|
||||||
getUUID :: Annex UUID
|
getUUID :: Annex UUID
|
||||||
|
|
|
@ -19,7 +19,6 @@ tests =
|
||||||
, testCp "cp_a" "-a"
|
, testCp "cp_a" "-a"
|
||||||
, testCp "cp_p" "-p"
|
, testCp "cp_p" "-p"
|
||||||
, testCp "cp_reflink_auto" "--reflink=auto"
|
, testCp "cp_reflink_auto" "--reflink=auto"
|
||||||
, TestCase "uuid generator" $ selectCmd "uuid" [("uuid -m", ""), ("uuid", ""), ("uuidgen", "")]
|
|
||||||
, TestCase "xargs -0" $ requireCmd "xargs_0" "xargs -0 </dev/null"
|
, TestCase "xargs -0" $ requireCmd "xargs_0" "xargs -0 </dev/null"
|
||||||
, TestCase "rsync" $ requireCmd "rsync" "rsync --version >/dev/null"
|
, TestCase "rsync" $ requireCmd "rsync" "rsync --version >/dev/null"
|
||||||
, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null"
|
, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null"
|
||||||
|
|
|
@ -39,7 +39,6 @@ thirdpartyProgs = catMaybes
|
||||||
, Just "rsync"
|
, Just "rsync"
|
||||||
, Just "ssh"
|
, Just "ssh"
|
||||||
, Just "sh"
|
, Just "sh"
|
||||||
, headMaybe $ words SysConfig.uuid -- may include parameters
|
|
||||||
, ifset SysConfig.curl "curl"
|
, ifset SysConfig.curl "curl"
|
||||||
, ifset SysConfig.wget "wget"
|
, ifset SysConfig.wget "wget"
|
||||||
, ifset SysConfig.bup "bup"
|
, ifset SysConfig.bup "bup"
|
||||||
|
|
6
debian/changelog
vendored
6
debian/changelog
vendored
|
@ -1,3 +1,9 @@
|
||||||
|
git-annex (3.20130208) UNRELEASED; urgency=low
|
||||||
|
|
||||||
|
* Now uses the Haskell uuid library, rather than needing a uuid program.
|
||||||
|
|
||||||
|
-- Joey Hess <joeyh@debian.org> Sun, 10 Feb 2013 14:52:01 -0400
|
||||||
|
|
||||||
git-annex (3.20130207) unstable; urgency=low
|
git-annex (3.20130207) unstable; urgency=low
|
||||||
|
|
||||||
* webapp: Now allows restarting any threads that crash.
|
* webapp: Now allows restarting any threads that crash.
|
||||||
|
|
1
debian/control
vendored
1
debian/control
vendored
|
@ -17,6 +17,7 @@ Build-Depends:
|
||||||
libghc-quickcheck2-dev,
|
libghc-quickcheck2-dev,
|
||||||
libghc-monad-control-dev (>= 0.3),
|
libghc-monad-control-dev (>= 0.3),
|
||||||
libghc-lifted-base-dev,
|
libghc-lifted-base-dev,
|
||||||
|
libghc-uuid-dev,
|
||||||
libghc-json-dev,
|
libghc-json-dev,
|
||||||
libghc-ifelse-dev,
|
libghc-ifelse-dev,
|
||||||
libghc-bloomfilter-dev,
|
libghc-bloomfilter-dev,
|
||||||
|
|
|
@ -20,6 +20,7 @@ quite a lot.
|
||||||
* [hS3](http://hackage.haskell.org/package/hS3) (optional)
|
* [hS3](http://hackage.haskell.org/package/hS3) (optional)
|
||||||
* [DAV](http://hackage.haskell.org/package/DAV) (optional)
|
* [DAV](http://hackage.haskell.org/package/DAV) (optional)
|
||||||
* [SafeSemaphore](http://hackage.haskell.org/package/SafeSemaphore)
|
* [SafeSemaphore](http://hackage.haskell.org/package/SafeSemaphore)
|
||||||
|
* [UUID](http://hackage.haskell.org/package/uuid)
|
||||||
* Optional haskell stuff, used by the [[assistant]] and its webapp (edit Makefile to disable)
|
* Optional haskell stuff, used by the [[assistant]] and its webapp (edit Makefile to disable)
|
||||||
* [stm](http://hackage.haskell.org/package/stm)
|
* [stm](http://hackage.haskell.org/package/stm)
|
||||||
(version 2.3 or newer)
|
(version 2.3 or newer)
|
||||||
|
@ -48,8 +49,6 @@ quite a lot.
|
||||||
* [async](http://hackage.haskell.org/package/async)
|
* [async](http://hackage.haskell.org/package/async)
|
||||||
* Shell commands
|
* Shell commands
|
||||||
* [git](http://git-scm.com/)
|
* [git](http://git-scm.com/)
|
||||||
* [uuid](http://www.ossp.org/pkg/lib/uuid/)
|
|
||||||
(or `uuidgen` from util-linux)
|
|
||||||
* [xargs](http://savannah.gnu.org/projects/findutils/)
|
* [xargs](http://savannah.gnu.org/projects/findutils/)
|
||||||
* [rsync](http://rsync.samba.org/)
|
* [rsync](http://rsync.samba.org/)
|
||||||
* [curl](http://http://curl.haxx.se/) (optional, but recommended)
|
* [curl](http://http://curl.haxx.se/) (optional, but recommended)
|
||||||
|
|
|
@ -60,7 +60,7 @@ Executable git-annex
|
||||||
pcre-light, extensible-exceptions, dataenc, SHA, process, json,
|
pcre-light, extensible-exceptions, dataenc, SHA, process, json,
|
||||||
base (>= 4.5 && < 4.8), monad-control, transformers-base, lifted-base,
|
base (>= 4.5 && < 4.8), monad-control, transformers-base, lifted-base,
|
||||||
IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,
|
IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,
|
||||||
SafeSemaphore
|
SafeSemaphore, UUID
|
||||||
-- Need to list these because they're generated from .hsc files.
|
-- Need to list these because they're generated from .hsc files.
|
||||||
Other-Modules: Utility.Touch Utility.Mounts
|
Other-Modules: Utility.Touch Utility.Mounts
|
||||||
Include-Dirs: Utility
|
Include-Dirs: Utility
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue