GIT_ANNEX_SHELL_APPENDONLY
Makes it allow writes, but not deletion of annexed content. Note that securing pushes to the git repository is left up to the user. This commit was sponsored by Jack Hill on Patreon.
This commit is contained in:
parent
0003109f5d
commit
85f9360d9b
7 changed files with 120 additions and 50 deletions
|
@ -411,13 +411,21 @@ serveAuth myuuid = serverLoop handler
|
|||
return ServerContinue
|
||||
handler _ = return ServerUnexpected
|
||||
|
||||
data ServerMode = ServeReadOnly | ServeReadWrite
|
||||
data ServerMode
|
||||
= ServeReadOnly
|
||||
-- ^ Allow reading, but not writing.
|
||||
| ServeAppendOnly
|
||||
-- ^ Allow reading, and storing new objects, but not deleting objects.
|
||||
| ServeReadWrite
|
||||
-- ^ Full read and write access.
|
||||
deriving (Eq, Ord)
|
||||
|
||||
-- | Serve the protocol, with a peer that has authenticated.
|
||||
serveAuthed :: ServerMode -> UUID -> Proto ()
|
||||
serveAuthed servermode myuuid = void $ serverLoop handler
|
||||
where
|
||||
readonlyerror = net $ sendMessage (ERROR "this repository is read-only; write access denied")
|
||||
appendonlyerror = net $ sendMessage (ERROR "this repository is append-only; removal denied")
|
||||
handler (VERSION theirversion) = do
|
||||
let v = min theirversion maxProtocolVersion
|
||||
net $ setProtocolVersion v
|
||||
|
@ -439,22 +447,15 @@ serveAuthed servermode myuuid = void $ serverLoop handler
|
|||
ServeReadWrite -> do
|
||||
sendSuccess =<< local (removeContent key)
|
||||
return ServerContinue
|
||||
ServeAppendOnly -> do
|
||||
appendonlyerror
|
||||
return ServerContinue
|
||||
ServeReadOnly -> do
|
||||
readonlyerror
|
||||
return ServerContinue
|
||||
handler (PUT af key) = case servermode of
|
||||
ServeReadWrite -> do
|
||||
have <- local $ checkContentPresent key
|
||||
if have
|
||||
then net $ sendMessage ALREADY_HAVE
|
||||
else do
|
||||
let sizer = tmpContentSize key
|
||||
let storer = \o l b v -> unVerified $
|
||||
storeContent key af o l b v
|
||||
(ok, _v) <- receiveContent Nothing nullMeterUpdate sizer storer PUT_FROM
|
||||
when ok $
|
||||
local $ setPresent key myuuid
|
||||
return ServerContinue
|
||||
ServeReadWrite -> handleput af key
|
||||
ServeAppendOnly -> handleput af key
|
||||
ServeReadOnly -> do
|
||||
readonlyerror
|
||||
return ServerContinue
|
||||
|
@ -467,6 +468,10 @@ serveAuthed servermode myuuid = void $ serverLoop handler
|
|||
let goahead = net $ relayService service
|
||||
case (servermode, service) of
|
||||
(ServeReadWrite, _) -> goahead
|
||||
(ServeAppendOnly, UploadPack) -> goahead
|
||||
-- git protocol could be used to overwrite
|
||||
-- refs or something, so don't allow
|
||||
(ServeAppendOnly, ReceivePack) -> readonlyerror
|
||||
(ServeReadOnly, UploadPack) -> goahead
|
||||
(ServeReadOnly, ReceivePack) -> readonlyerror
|
||||
-- After connecting to git, there may be unconsumed data
|
||||
|
@ -479,6 +484,19 @@ serveAuthed servermode myuuid = void $ serverLoop handler
|
|||
return ServerContinue
|
||||
handler _ = return ServerUnexpected
|
||||
|
||||
handleput af key = do
|
||||
have <- local $ checkContentPresent key
|
||||
if have
|
||||
then net $ sendMessage ALREADY_HAVE
|
||||
else do
|
||||
let sizer = tmpContentSize key
|
||||
let storer = \o l b v -> unVerified $
|
||||
storeContent key af o l b v
|
||||
(ok, _v) <- receiveContent Nothing nullMeterUpdate sizer storer PUT_FROM
|
||||
when ok $
|
||||
local $ setPresent key myuuid
|
||||
return ServerContinue
|
||||
|
||||
sendContent :: Key -> AssociatedFile -> Offset -> MeterUpdate -> Proto Bool
|
||||
sendContent key af offset@(Offset n) p = go =<< local (contentSize key)
|
||||
where
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue