zfec-1.4.5/ 0000775 0001751 0001751 00000000000 11216213552 011536 5 ustar zooko zooko zfec-1.4.5/haskell/ 0000775 0001751 0001751 00000000000 11216213552 013161 5 ustar zooko zooko zfec-1.4.5/haskell/Codec/ 0000775 0001751 0001751 00000000000 11216213552 014176 5 ustar zooko zooko zfec-1.4.5/haskell/Codec/FEC.hs 0000664 0001751 0001751 00000025674 11216211330 015135 0 ustar zooko zooko {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
-- |
-- Module: Codec.FEC
-- Copyright: Adam Langley
-- License: BSD3
--
-- Stability: experimental
--
-- The module provides k of n encoding - a way to generate (n - k) secondary
-- blocks of data from k primary blocks such that any k blocks (primary or
-- secondary) are sufficient to regenerate all blocks.
--
-- All blocks must be the same length and you need to keep track of which
-- blocks you have in order to tell decode. By convention, the blocks are
-- numbered 0..(n - 1) and blocks numbered < k are the primary blocks.
module Codec.FEC (
FECParams
, fec
, encode
, decode
-- * Utility functions
, secureDivide
, secureCombine
, enFEC
, deFEC
) where
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as BU
import qualified Data.ByteString.Internal as BI
import Data.Word (Word8)
import Data.Bits (xor)
import Data.List (sortBy, partition, (\\), nub)
import Foreign.Ptr
import Foreign.Storable (sizeOf, poke)
import Foreign.ForeignPtr
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array (withArray, advancePtr)
import System.IO (withFile, IOMode(..))
import System.IO.Unsafe (unsafePerformIO)
data CFEC
data FECParams = FECParams (ForeignPtr CFEC) Int Int
instance Show FECParams where
show (FECParams _ k n) = "FEC (" ++ show k ++ ", " ++ show n ++ ")"
foreign import ccall unsafe "fec_new" _new :: CUInt -- ^ k
-> CUInt -- ^ n
-> IO (Ptr CFEC)
foreign import ccall unsafe "&fec_free" _free :: FunPtr (Ptr CFEC -> IO ())
foreign import ccall unsafe "fec_encode" _encode :: Ptr CFEC
-> Ptr (Ptr Word8) -- ^ primary blocks
-> Ptr (Ptr Word8) -- ^ (output) secondary blocks
-> Ptr CUInt -- ^ array of secondary block ids
-> CSize -- ^ length of previous
-> CSize -- ^ block length
-> IO ()
foreign import ccall unsafe "fec_decode" _decode :: Ptr CFEC
-> Ptr (Ptr Word8) -- ^ input blocks
-> Ptr (Ptr Word8) -- ^ output blocks
-> Ptr CUInt -- ^ array of input indexes
-> CSize -- ^ block length
-> IO ()
-- | Return true if the given @k@ and @n@ values are valid
isValidConfig :: Int -> Int -> Bool
isValidConfig k n
| k >= n = False
| k < 1 = False
| n < 1 = False
| n > 255 = False
| otherwise = True
-- | Return a FEC with the given parameters.
fec :: Int -- ^ the number of primary blocks
-> Int -- ^ the total number blocks, must be < 256
-> FECParams
fec k n =
if not (isValidConfig k n)
then error $ "Invalid FEC parameters: " ++ show k ++ " " ++ show n
else unsafePerformIO (do
cfec <- _new (fromIntegral k) (fromIntegral n)
params <- newForeignPtr _free cfec
return $ FECParams params k n)
-- | Create a C array of unsigned from an input array
uintCArray :: [Int] -> ((Ptr CUInt) -> IO a) -> IO a
uintCArray xs f = withArray (map fromIntegral xs) f
-- | Convert a list of ByteStrings to an array of pointers to their data
byteStringsToArray :: [B.ByteString] -> ((Ptr (Ptr Word8)) -> IO a) -> IO a
byteStringsToArray inputs f = do
let l = length inputs
allocaBytes (l * sizeOf (undefined :: Ptr Word8)) (\array -> do
let inner _ [] = f array
inner array' (bs : bss) = BU.unsafeUseAsCString bs (\ptr -> do
poke array' $ castPtr ptr
inner (advancePtr array' 1) bss)
inner array inputs)
-- | Return True iff all the given ByteStrings are the same length
allByteStringsSameLength :: [B.ByteString] -> Bool
allByteStringsSameLength [] = True
allByteStringsSameLength (bs : bss) = all ((==) (B.length bs)) $ map B.length bss
-- | Run the given function with a pointer to an array of @n@ pointers to
-- buffers of size @size@. Return these buffers as a list of ByteStrings
createByteStringArray :: Int -- ^ the number of buffers requested
-> Int -- ^ the size of each buffer
-> ((Ptr (Ptr Word8)) -> IO ())
-> IO [B.ByteString]
createByteStringArray n size f = do
allocaBytes (n * sizeOf (undefined :: Ptr Word8)) (\array -> do
allocaBytes (n * size) (\ptr -> do
mapM_ (\i -> poke (advancePtr array i) (advancePtr ptr (size * i))) [0..(n - 1)]
f array
mapM (\i -> B.packCStringLen (castPtr $ advancePtr ptr (i * size), size)) [0..(n - 1)]))
-- | Generate the secondary blocks from a list of the primary blocks. The
-- primary blocks must be in order and all of the same size. There must be
-- @k@ primary blocks.
encode :: FECParams
-> [B.ByteString] -- ^ a list of @k@ input blocks
-> [B.ByteString] -- ^ (n - k) output blocks
encode (FECParams params k n) inblocks
| length inblocks /= k = error "Wrong number of blocks to FEC encode"
| not (allByteStringsSameLength inblocks) = error "Not all inputs to FEC encode are the same length"
| otherwise = unsafePerformIO (do
let sz = B.length $ head inblocks
withForeignPtr params (\cfec -> do
byteStringsToArray inblocks (\src -> do
createByteStringArray (n - k) sz (\fecs -> do
uintCArray [k..(n - 1)] (\block_nums -> do
_encode cfec src fecs block_nums (fromIntegral (n - k)) $ fromIntegral sz)))))
-- | A sort function for tagged assoc lists
sortTagged :: [(Int, a)] -> [(Int, a)]
sortTagged = sortBy (\a b -> compare (fst a) (fst b))
-- | Reorder the given list so that elements with tag numbers < the first
-- argument have an index equal to their tag number (if possible)
reorderPrimaryBlocks :: Int -> [(Int, a)] -> [(Int, a)]
reorderPrimaryBlocks n blocks = inner (sortTagged pBlocks) sBlocks [] where
(pBlocks, sBlocks) = partition (\(tag, _) -> tag < n) blocks
inner [] sBlocks acc = acc ++ sBlocks
inner pBlocks [] acc = acc ++ pBlocks
inner pBlocks@((tag, a) : ps) sBlocks@(s : ss) acc =
if length acc == tag
then inner ps sBlocks (acc ++ [(tag, a)])
else inner pBlocks ss (acc ++ [s])
-- | Recover the primary blocks from a list of @k@ blocks. Each block must be
-- tagged with its number (see the module comments about block numbering)
decode :: FECParams
-> [(Int, B.ByteString)] -- ^ a list of @k@ blocks and their index
-> [B.ByteString] -- ^ a list the @k@ primary blocks
decode (FECParams params k n) inblocks
| length (nub $ map fst inblocks) /= length (inblocks) = error "Duplicate input blocks in FEC decode"
| any (\f -> f < 0 || f >= n) $ map fst inblocks = error "Invalid block numbers in FEC decode"
| length inblocks /= k = error "Wrong number of blocks to FEC decode"
| not (allByteStringsSameLength $ map snd inblocks) = error "Not all inputs to FEC decode are same length"
| otherwise = unsafePerformIO (do
let sz = B.length $ snd $ head inblocks
inblocks' = reorderPrimaryBlocks k inblocks
presentBlocks = map fst inblocks'
withForeignPtr params (\cfec -> do
byteStringsToArray (map snd inblocks') (\src -> do
b <- createByteStringArray (n - k) sz (\out -> do
uintCArray presentBlocks (\block_nums -> do
_decode cfec src out block_nums $ fromIntegral sz))
let blocks = [0..(n - 1)] \\ presentBlocks
tagged = zip blocks b
allBlocks = sortTagged $ tagged ++ inblocks'
return $ take k $ map snd allBlocks)))
-- | Break a ByteString into @n@ parts, equal in length to the original, such
-- that all @n@ are required to reconstruct the original, but having less
-- than @n@ parts reveals no information about the orginal.
--
-- This code works in IO monad because it needs a source of random bytes,
-- which it gets from /dev/urandom. If this file doesn't exist an
-- exception results
--
-- Not terribly fast - probably best to do it with short inputs (e.g. an
-- encryption key)
secureDivide :: Int -- ^ the number of parts requested
-> B.ByteString -- ^ the data to be split
-> IO [B.ByteString]
secureDivide n input
| n < 0 = error "secureDivide called with negative number of parts"
| otherwise = withFile "/dev/urandom" ReadMode (\handle -> do
let inner 1 bs = return [bs]
inner n bs = do
mask <- B.hGet handle (B.length bs)
let masked = B.pack $ B.zipWith xor bs mask
rest <- inner (n - 1) masked
return (mask : rest)
inner n input)
-- | Reverse the operation of secureDivide. The order of the inputs doesn't
-- matter, but they must all be the same length
secureCombine :: [B.ByteString] -> B.ByteString
secureCombine [] = error "Passed empty list of inputs to secureCombine"
secureCombine [a] = a
secureCombine [a, b] = B.pack $ B.zipWith xor a b
secureCombine (a : rest) = B.pack $ B.zipWith xor a $ secureCombine rest
-- | A utility function which takes an arbitary input and FEC encodes it into a
-- number of blocks. The order the resulting blocks doesn't matter so long
-- as you have enough to present to @deFEC@.
enFEC :: Int -- ^ the number of blocks required to reconstruct
-> Int -- ^ the total number of blocks
-> B.ByteString -- ^ the data to divide
-> [B.ByteString] -- ^ the resulting blocks
enFEC k n input = taggedPrimaryBlocks ++ taggedSecondaryBlocks where
taggedPrimaryBlocks = map (uncurry B.cons) $ zip [0..] primaryBlocks
taggedSecondaryBlocks = map (uncurry B.cons) $ zip [(fromIntegral k)..] secondaryBlocks
remainder = B.length input `mod` k
paddingLength = if remainder >= 1 then (k - remainder) else k
paddingBytes = (B.replicate (paddingLength - 1) 0) `B.append` (B.singleton $ fromIntegral paddingLength)
divide a bs
| B.null bs = []
| otherwise = (B.take a bs) : (divide a $ B.drop a bs)
input' = input `B.append` paddingBytes
blockSize = B.length input' `div` k
primaryBlocks = divide blockSize input'
secondaryBlocks = encode params primaryBlocks
params = fec k n
-- | Reverses the operation of @enFEC@.
deFEC :: Int -- ^ the number of blocks required (matches call to @enFEC@)
-> Int -- ^ the total number of blocks (matches call to @enFEC@)
-> [B.ByteString] -- ^ a list of k, or more, blocks from @enFEC@
-> B.ByteString
deFEC k n inputs
| length inputs < k = error "Too few inputs to deFEC"
| otherwise = B.take (B.length fecOutput - paddingLength) fecOutput where
paddingLength = fromIntegral $ B.last fecOutput
inputs' = take k inputs
taggedInputs = map (\bs -> (fromIntegral $ B.head bs, B.tail bs)) inputs'
fecOutput = B.concat $ decode params taggedInputs
params = fec k n
zfec-1.4.5/haskell/test/ 0000775 0001751 0001751 00000000000 11216213552 014140 5 ustar zooko zooko zfec-1.4.5/haskell/test/FECTest.hs 0000664 0001751 0001751 00000003402 11216211330 015720 0 ustar zooko zooko module Main where
import qualified Data.ByteString as B
import qualified Codec.FEC as FEC
import System.IO (withFile, IOMode(..))
import System.Random
import Data.List (sortBy)
import Test.QuickCheck
-- | Return true if the given @k@ and @n@ values are valid
isValidConfig :: Int -> Int -> Bool
isValidConfig k n
| k >= n = False
| k < 1 = False
| n < 1 = False
| otherwise = True
randomTake :: Int -> Int -> [a] -> [a]
randomTake seed n values = map snd $ take n sortedValues where
sortedValues = sortBy (\a b -> compare (fst a) (fst b)) taggedValues
taggedValues = zip rnds values
rnds :: [Float]
rnds = randoms gen
gen = mkStdGen seed
testFEC k n len seed = FEC.decode fec someTaggedBlocks == origBlocks where
origBlocks = map (\i -> B.replicate len $ fromIntegral i) [0..(k - 1)]
fec = FEC.fec k n
secondaryBlocks = FEC.encode fec origBlocks
taggedBlocks = zip [0..] (origBlocks ++ secondaryBlocks)
someTaggedBlocks = randomTake seed k taggedBlocks
prop_FEC :: Int -> Int -> Int -> Int -> Property
prop_FEC k n len seed =
isValidConfig k n && n < 256 && len < 1024 ==> testFEC k n len seed
checkDivide :: Int -> IO ()
checkDivide n = do
let input = B.replicate 1024 65
parts <- FEC.secureDivide n input
if FEC.secureCombine parts == input
then return ()
else fail "checkDivide failed"
checkEnFEC :: Int -> IO ()
checkEnFEC len = do
testdata <- withFile "/dev/urandom" ReadMode (\handle -> B.hGet handle len)
let [a, b, c, d, e] = FEC.enFEC 3 5 testdata
if FEC.deFEC 3 5 [b, e, d] == testdata
then return ()
else fail "deFEC failure"
main = do
mapM_ (check (defaultConfig { configMaxTest = 1000, configMaxFail = 10000 })) [prop_FEC]
mapM_ checkDivide [1, 2, 3, 4, 10]
mapM_ checkEnFEC [1, 2, 3, 4, 5, 1024 * 1024]
zfec-1.4.5/PKG-INFO 0000664 0001751 0001751 00000004047 11216213552 012640 0 ustar zooko zooko Metadata-Version: 1.0
Name: zfec
Version: 1.4.5
Summary: a fast erasure codec which can be used with the command-line, C, Python, or Haskell
Home-page: http://allmydata.org/trac/zfec
Author: Zooko O'Whielacronx
Author-email: zooko@zooko.com
License: GNU GPL
Description: Fast, portable, programmable erasure coding a.k.a. "forward error correction": the generation of redundant blocks of information such that if some blocks are lost then the original data can be recovered from the remaining blocks. The zfec package includes command-line tools, C API, Python API, and Haskell API
Platform: UNKNOWN
Classifier: Development Status :: 5 - Production/Stable
Classifier: Environment :: Console
Classifier: License :: OSI Approved :: GNU General Public License (GPL)
Classifier: License :: DFSG approved
Classifier: License :: Other/Proprietary License
Classifier: Intended Audience :: Developers
Classifier: Intended Audience :: End Users/Desktop
Classifier: Intended Audience :: System Administrators
Classifier: Operating System :: Microsoft
Classifier: Operating System :: Microsoft :: Windows
Classifier: Operating System :: Unix
Classifier: Operating System :: POSIX :: Linux
Classifier: Operating System :: POSIX
Classifier: Operating System :: MacOS :: MacOS X
Classifier: Operating System :: Microsoft :: Windows :: Windows NT/2000
Classifier: Operating System :: OS Independent
Classifier: Natural Language :: English
Classifier: Programming Language :: C
Classifier: Programming Language :: Python
Classifier: Programming Language :: Python :: 2
Classifier: Programming Language :: Python :: 2.4
Classifier: Programming Language :: Python :: 2.5
Classifier: Topic :: Utilities
Classifier: Topic :: System :: Systems Administration
Classifier: Topic :: System :: Filesystems
Classifier: Topic :: System :: Distributed Computing
Classifier: Topic :: Software Development :: Libraries
Classifier: Topic :: Communications :: Usenet News
Classifier: Topic :: System :: Archiving :: Backup
Classifier: Topic :: System :: Archiving :: Mirroring
Classifier: Topic :: System :: Archiving
zfec-1.4.5/setup.py 0000664 0001751 0001751 00000014340 11216212157 013252 0 ustar zooko zooko #!/usr/bin/env python
# zfec -- fast forward error correction library with Python interface
#
# Copyright (C) 2007-2008 Allmydata, Inc.
# Author: Zooko Wilcox-O'Hearn
#
# This file is part of zfec.
#
# See README.txt for licensing information.
import os, re, sys
miscdeps=os.path.join(os.getcwd(), 'misc', 'dependencies')
try:
from ez_setup import use_setuptools
except ImportError:
pass
else:
use_setuptools(min_version='0.6c9', download_delay=0, to_dir=miscdeps)
from setuptools import Extension, find_packages, setup
if "--debug" in sys.argv:
DEBUGMODE=True
sys.argv.remove("--debug")
else:
DEBUGMODE=False
extra_compile_args=[]
extra_link_args=[]
extra_compile_args.append("-std=c99")
define_macros=[]
undef_macros=[]
for arg in sys.argv:
if arg.startswith("--stride="):
stride = int(arg[len("--stride="):])
define_macros.append(('STRIDE', stride))
sys.argv.remove(arg)
break
if DEBUGMODE:
extra_compile_args.append("-O0")
extra_compile_args.append("-g")
extra_compile_args.append("-Wall")
extra_link_args.append("-g")
undef_macros.append('NDEBUG')
trove_classifiers=[
"Development Status :: 5 - Production/Stable",
"Environment :: Console",
"License :: OSI Approved :: GNU General Public License (GPL)",
"License :: DFSG approved",
"License :: Other/Proprietary License",
"Intended Audience :: Developers",
"Intended Audience :: End Users/Desktop",
"Intended Audience :: System Administrators",
"Operating System :: Microsoft",
"Operating System :: Microsoft :: Windows",
"Operating System :: Unix",
"Operating System :: POSIX :: Linux",
"Operating System :: POSIX",
"Operating System :: MacOS :: MacOS X",
"Operating System :: Microsoft :: Windows :: Windows NT/2000",
"Operating System :: OS Independent",
"Natural Language :: English",
"Programming Language :: C",
"Programming Language :: Python",
"Programming Language :: Python :: 2",
"Programming Language :: Python :: 2.4",
"Programming Language :: Python :: 2.5",
"Topic :: Utilities",
"Topic :: System :: Systems Administration",
"Topic :: System :: Filesystems",
"Topic :: System :: Distributed Computing",
"Topic :: Software Development :: Libraries",
"Topic :: Communications :: Usenet News",
"Topic :: System :: Archiving :: Backup",
"Topic :: System :: Archiving :: Mirroring",
"Topic :: System :: Archiving",
]
PKG = "zfec"
VERSIONFILE = os.path.join(PKG, "_version.py")
verstr = "unknown"
try:
verstrline = open(VERSIONFILE, "rt").read()
except EnvironmentError:
pass # Okay, there is no version file.
else:
VSRE = r"^verstr = ['\"]([^'\"]*)['\"]"
mo = re.search(VSRE, verstrline, re.M)
if mo:
verstr = mo.group(1)
else:
print "unable to find version in %s" % (VERSIONFILE,)
raise RuntimeError("if %s.py exists, it is required to be well-formed" % (VERSIONFILE,))
dependency_links=[os.path.join(miscdeps, t) for t in os.listdir(miscdeps) if t.endswith(".tar")]
setup_requires = []
# The darcsver command from the darcsver plugin is needed to initialize the
# distribution's .version attribute correctly. (It does this either by
# examining darcs history, or if that fails by reading the
# zfec/_version.py file). darcsver will also write a new version
# stamp in zfec/_version.py, with a version number derived from
# darcs history. Note that the setup.cfg file has an "[aliases]" section
# which enumerates commands that you might run and specifies that it will run
# darcsver before each one. If you add different commands (or if I forgot
# some that are already in use), you may need to add it to setup.cfg and
# configure it to run darcsver before your command, if you want the version
# number to be correct when that command runs.
# http://pypi.python.org/pypi/darcsver
setup_requires.append('darcsver >= 1.2.0')
# setuptools_darcs is required to produce complete distributions (such as with
# "sdist" or "bdist_egg"), unless there is a zfec.egg-info/SOURCE.txt file
# present which contains a complete list of files that should be included.
# http://pypi.python.org/pypi/setuptools_darcs
setup_requires.append('setuptools_darcs >= 1.1.0')
data_fnames=[ 'COPYING.GPL', 'changelog', 'COPYING.TGPPL.html', 'TODO', 'README.txt' ]
# In case we are building for a .deb with stdeb's sdist_dsc command, we put the
# docs in "share/doc/python-$PKG".
doc_loc = "share/doc/python-" + PKG
data_files = [(doc_loc, data_fnames)]
def _setup(test_suite):
setup(name=PKG,
version=verstr,
description='a fast erasure codec which can be used with the command-line, C, Python, or Haskell',
long_description='Fast, portable, programmable erasure coding a.k.a. "forward error correction": the generation of redundant blocks of information such that if some blocks are lost then the original data can be recovered from the remaining blocks. The zfec package includes command-line tools, C API, Python API, and Haskell API',
author='Zooko O\'Whielacronx',
author_email='zooko@zooko.com',
url='http://allmydata.org/trac/'+PKG,
license='GNU GPL',
dependency_links=dependency_links,
install_requires=["argparse >= 0.8", "pyutil >= 1.3.19"],
tests_require=["pyutil >= 1.3.19"],
packages=find_packages(),
include_package_data=True,
data_files=data_files,
setup_requires=setup_requires,
classifiers=trove_classifiers,
entry_points = { 'console_scripts': [ 'zfec = %s.cmdline_zfec:main' % PKG, 'zunfec = %s.cmdline_zunfec:main' % PKG ] },
ext_modules=[Extension(PKG+'._fec', [PKG+'/fec.c', PKG+'/_fecmodule.c',], extra_link_args=extra_link_args, extra_compile_args=extra_compile_args, undef_macros=undef_macros, define_macros=define_macros),],
test_suite=test_suite,
zip_safe=False, # I prefer unzipped for easier access.
)
test_suite_name=PKG+".test"
try:
_setup(test_suite=test_suite_name)
except Exception, le:
# to work around a bug in Elisa v0.3.5
# https://bugs.launchpad.net/elisa/+bug/263697
if "test_suite must be a list" in str(le):
_setup(test_suite=[test_suite_name])
else:
raise
zfec-1.4.5/README.txt 0000664 0001751 0001751 00000031341 11216212136 013233 0 ustar zooko zooko * Intro and Licence
This package implements an "erasure code", or "forward error correction code".
You may use this package under the GNU General Public License, version 2 or, at
your option, any later version. You may use this package under the Transitive
Grace Period Public Licence, version 1.0. (You may choose to use this package
under the terms of either licence, at your option.) See the file COPYING.GPL
for the terms of the GNU General Public License, version 2. See the file
COPYING.TGPPL.html for the terms of the Transitive Grace Period Public Licence,
version 1.0. In addition, Allmydata, Inc. offers other licensing terms. If you
would like to inquire about a commercial relationship with Allmydata, Inc.,
please contact partnerships@allmydata.com and visit http://allmydata.com .
The most widely known example of an erasure code is the RAID-5 algorithm which
makes it so that in the event of the loss of any one hard drive, the stored data
can be completely recovered. The algorithm in the zfec package has a similar
effect, but instead of recovering from the loss of only a single element, it can
be parameterized to choose in advance the number of elements whose loss it can
tolerate.
This package is largely based on the old "fec" library by Luigi Rizzo et al.,
which is a mature and optimized implementation of erasure coding. The zfec
package makes several changes from the original "fec" package, including
addition of the Python API, refactoring of the C API to support zero-copy
operation, a few clean-ups and optimizations of the core code itself, and the
addition of a command-line tool named "zfec".
* Installation
This package is managed with the "setuptools" package management tool. To build
and install the package directly into your system, just run "python ./setup.py
install". If you prefer to keep the package limited to a specific directory so
that you can manage it yourself (perhaps by using the "GNU stow") tool, then
give it these arguments: "python ./setup.py install
--single-version-externally-managed
--record=${specificdirectory}/zfec-install.log --prefix=${specificdirectory}"
To run the self-tests, execute "python ./setup.py test" (or if you have Twisted
Python installed, you can run "trial zfec" for nicer output and test options.)
This will run the tests of the C API, the Python API, and the command-line
tools.
To run the tests of the Haskell API:
% runhaskell haskell/test/FECTest.hs
Note that in order to run the Haskell API tests you must have installed the
library first due to the fact that the interpreter cannot process FEC.hs as it
takes a reference to an FFI function.
* Community
The source is currently available via darcs on the web with the command:
darcs get http://allmydata.org/source/zfec/trunk
More information on darcs is available at http://darcs.net
Please join the zfec mailing list and submit patches:
This Transitive Grace Period Public Licence (the "License") applies to any original work of authorship (the "Original Work") whose owner (the "Licensor") has placed the following licensing notice adjacent to the copyright notice for the Original Work: Licensed under the Transitive Grace Period Public Licence version 1.0Transitive Grace Period Public Licence ("TGPPL") v. 1.0