Add request_body_set_permissions()

R/request_body_list_files.R

@@ -2,9 +2,7 @@
 request_body_list_files <- function()
 {
   property_strings <- get_property_info(as_data_frame = FALSE)
-
   property_elements <- lapply(property_strings, tag_xml)
-
   request_body(element_propfind(do.call(element_prop, property_elements)))
 }
 
@@ -111,18 +109,22 @@ element_propfind <- function(
   ..., owncloud = TRUE, nextcloud = TRUE, depth = 0L
 )
 {
-  attributes <- attributes_propfind(owncloud, nextcloud)
-
+  attributes <- attributes_cloud_urls(owncloud, nextcloud, opencoll = FALSE)
   element_xml("d:propfind", ..., attributes = attributes, depth = depth)
 }
 
-# attributes_propfind ----------------------------------------------------------
-attributes_propfind <- function(owncloud = TRUE, nextcloud = TRUE)
+# attributes_cloud_urls --------------------------------------------------------
+attributes_cloud_urls <- function(
+    owncloud = TRUE,
+    nextcloud = TRUE,
+    opencoll = TRUE
+)
 {
   c(
     list("xmlns:d" = "DAV:"),
     if (owncloud) list("xmlns:oc" = "http://owncloud.org/ns"),
-    if (nextcloud) list("xmlns:nc" = "http://nextcloud.org/ns")
+    if (nextcloud) list("xmlns:nc" = "http://nextcloud.org/ns"),
+    if (opencoll) list("xmlns:ocs" = "http://open-collaboration-services.org/ns")
   )
 }
 
@@ -139,6 +141,12 @@ element_xml <- function(x, ..., attributes = list(), depth = 0L)
   kwb.utils::indent(strings, depth)
 }
 
+# inline_element_xml -----------------------------------------------------------
+inline_element_xml <- function(name, value)
+{
+  paste0(tag_xml(name, close = FALSE), value, tag_xml(name, close = 2L))
+}
+
 # tag_xml ----------------------------------------------------------------------
 
 #' @importFrom kwb.utils indent
@@ -162,4 +170,3 @@ element_prop <- function(..., attributes = NULL, depth = 0L)
 {
   element_xml("d:prop", ..., attributes = attributes, depth = depth)
 }
-

R/request_body_set_permissions.R

@@ -0,0 +1,45 @@
+# request_body_set_permissions -------------------------------------------------
+#' @examples
+#' cat(request_body_set_permissions(
+#'   group_info = list(name = "agroup", mask = 16L, permissions = 15L),
+#'   user_info = list(name = "anuser", mask = 16L, permissions = 15L)
+#' ))
+request_body_set_permissions <- function(group_info, user_info)
+{
+  nc_acl <- function(type, name, mask, permissions) {
+    element_xml(
+      "nc:acl",
+      inline_element_xml("nc:acl-mapping-type", type),
+      inline_element_xml("nc:acl-mapping-id", name),
+      inline_element_xml("nc:acl-mask", mask),
+      inline_element_xml("nc:acl-permissions", permissions)
+    )
+  }
+
+  paste(collapse = "\n", c(
+    paste0("<?xml version=", dq("1.0"), "?>"),
+    element_xml(
+      "d:propertyupdate",
+      attributes = attributes_cloud_urls(),
+      element_xml(
+        "d:set", element_xml(
+          "d:prop", element_xml(
+            "nc:acl-list",
+            nc_acl("group", group_info$name, group_info$mask, group_info$permissions),
+            nc_acl("user", user_info$name, user_info$mask, user_info$permissions)
+          )
+        )
+      )
+    )
+  ))
+}
+
+# code_to_value <- function(code) {
+#   sum(c(r = 4L, w = 2L, x = 1L)[strsplit(code, "")[[1L]]])
+# }
+#
+# list(
+#   user = code_to_value("rwx"),
+#   group = code_to_value("rx"),
+#   other = code_to_value("r")
+# )

tests/testthat/test-function-attributes_cloud_urls.R

@@ -0,0 +1,6 @@
+test_that("attributes_cloud_urls() works", {
+
+  f <- kwb.nextcloud:::attributes_cloud_urls
+  result <- f()
+  expect_is(result, "list")
+})