xquery version "3.0";
(:
    ART-DECOR® STANDARD COPYRIGHT AND LICENSE NOTE
    Copyright © ART-DECOR Expert Group and ART-DECOR Open Tools GmbH
    see https://docs.art-decor.org/copyright and https://docs.art-decor.org/licenses

    This file is part of the ART-DECOR® tools suite.
:)
module namespace adpfix             = "http://art-decor.org/ns/art-decor-permissions";
import module namespace get         = "http://art-decor.org/ns/art-decor-settings" at "../modules/art-decor-settings.xqm";
import module namespace adserver    = "http://art-decor.org/ns/art-decor-server" at "api-server-settings.xqm";
import module namespace aduser      = "http://art-decor.org/ns/art-decor-users" at "api-user-settings.xqm";

declare namespace sm            = "http://exist-db.org/xquery/securitymanager";
declare namespace util          = "http://exist-db.org/xquery/util";
declare namespace xforms        = "http://www.w3.org/2002/xforms";
declare namespace xxforms       = "http://orbeon.org/oxf/xml/xforms";
declare namespace xhtml         = "http://www.w3.org/1999/xhtml";

(:  Mode            Octal
 :  rw-r--r--   ==  0644
 :  rw-rw-r--   ==  0664
 :  rwxr-xr--   ==  0754
 :  rwxr-xr-x   ==  0755
 :  rwxrwxr-x   ==  0775
 :)

(:install path for art (normally /db/apps/), includes trailing slash :)
declare variable $adpfix:root   := repo:get-root();

(:
:   Call to fix any potential permissions problems in the paths
:       /db/apps/art/modules
:       /db/apps/art/resources
:       /db/apps/art-data
:   Dependency: $get:strArt, $get:strArtResources, $get:strArtData
:)
declare function adpfix:setArtPermissions() {
    adpfix:checkIfUserDba(),
    sm:chown(xs:anyURI($get:strArtResources),'admin:decor'),
    sm:chmod(xs:anyURI($get:strArtResources),sm:octal-to-mode('0775')),
    sm:clear-acl(xs:anyURI($get:strArtResources)),
    
    sm:chown(xs:anyURI($get:strDecorLocks),'admin:decor'),
    sm:chmod(xs:anyURI($get:strDecorLocks),sm:octal-to-mode('0775')),
    sm:clear-acl(xs:anyURI($get:strDecorLocks)),
    
    adpfix:setArtQueryPermissions(),
    adpfix:setArtDataPermissions(),
    aduser:patchAllUserInfo()
};

(:
:   Call to fix any potential permissions problems in the path /db/apps/art/modules
:   Dependency: $get:strArt
:)
declare %private function adpfix:setArtQueryPermissions() {
    for $query in xmldb:get-child-resources(xs:anyURI(concat($get:strArt,'/modules')))
    return (
        sm:chown(xs:anyURI(concat($adpfix:root,'art/modules/',$query)),'admin:decor'),
        if (starts-with($query,('art-decor','check','collect','get','login','retrieve','search'))) then
            sm:chmod(xs:anyURI(concat($adpfix:root,'art/modules/',$query)),sm:octal-to-mode('0755'))
        else if ($query='save-user-details.xquery') then (
            (: special case. all logged-in users need at least r-x access to this one, so only guest is excluded :)
            sm:chmod(xs:anyURI(concat($adpfix:root,'art/modules/',$query)),sm:octal-to-mode('0755')),
            sm:clear-acl(xs:anyURI(concat($adpfix:root,'art/modules/',$query))),
            sm:add-user-ace(xs:anyURI(concat($adpfix:root,'art/modules/',$query)),'guest',false(),'rwx')
        )
        else (
            sm:chmod(xs:anyURI(concat($adpfix:root,'art/modules/',$query)),sm:octal-to-mode('0754'))
        )
        ,
        sm:clear-acl(xs:anyURI(concat($adpfix:root,'art/modules/',$query)))
    )
};

(:
:   Call to fix any potential permissions problems in the path /db/apps/art-data
:   Dependency: $get:strArtData
:)
declare %private function adpfix:setArtDataPermissions() {
    sm:chown(xs:anyURI($get:strArtData),'admin:decor'),
    sm:chmod(xs:anyURI($get:strArtData),'rwxrwxr-x'),
    sm:clear-acl(xs:anyURI($get:strArtData))
    ,
    for $file in xmldb:get-child-resources(xs:anyURI($get:strArtData))
    return (
        sm:chown(xs:anyURI(concat($get:strArtData,'/',$file)),'admin:decor'),
        sm:chmod(xs:anyURI(concat($get:strArtData,'/',$file)),'rw-r--r--'),
        sm:clear-acl(xs:anyURI(concat($get:strArtData,'/',$file)))
    )
    ,
    for $file in xmldb:get-child-resources(xs:anyURI($get:strArtData))[.=('decor-locks.xml','user-subscriptions.xml')]
    return (
        sm:chmod(xs:anyURI(concat($get:strArtData,'/',$file)),'rw-rw-rw-'),
        (: special case. all logged-in users need at least rw- access to this one, so only guest is excluded :)
        sm:add-user-ace(xs:anyURI(concat($get:strArtData,'/',$file)),'guest',false(),'w')
    )
    ,
    for $file in xmldb:get-child-resources(xs:anyURI($get:strArtData))[.=('user-info.xml')]
    return (
        (: special case. all logged-in users and guest need rw- access to this one, api-user-settings.xqm handles further exceptions :)
        sm:chmod(xs:anyURI(concat($get:strArtData,'/',$file)),'rw-rw-rw-')
    )
};

(:
:   Call to fix any potential permissions problems in the paths:
:       /db/apps/decor/cache
:       /db/apps/decor/data
:       /db/apps/decor/releases
:   Dependency: $get:strArtData, $get:strDecorCache, $get:strDecorData, $get:strDecorVersion
:   NOTE: path /db/apps/decor/core has its own installer
:)
declare function adpfix:setDecorPermissions() {
    adpfix:checkIfUserDba(),
    sm:chown(xs:anyURI(concat($adpfix:root,'decor')),'admin:decor'),
    sm:chmod(xs:anyURI(concat($adpfix:root,'decor')),sm:octal-to-mode('0775')),
    sm:clear-acl(xs:anyURI(concat($adpfix:root,'decor'))),
    
    adpfix:setPermissions($get:strDecorCache,   'admin', 'decor', 'rwxrwsr-x', 'admin', 'decor', 'rw-r--r--'),
    adpfix:setPermissions($get:strDecorData,    'admin', 'decor', 'rwxrwsr-x', 'admin', 'decor', 'rw-rw-r--'),
    if (xmldb:collection-available($get:strDecorHistory)) then () else (
        xmldb:create-collection(string-join(tokenize($get:strDecorHistory,'/')[not(position()=last())],'/'), tokenize($get:strDecorHistory,'/')[last()])
    ),
    adpfix:setPermissions($get:strDecorHistory, 'admin', 'decor', 'rwxrwsr-x', 'admin', 'decor', 'rw-rw-r--')
    ,
    adpfix:setPermissions($get:strDecorDataIG, 'admin', 'decor', 'rwxrwsr-x', 'admin', 'decor', 'rw-rw-r--')
    ,
    (:if (xmldb:collection-available($get:strDecorDevelop)) then (
        adpfix:setPermissions($get:strDecorDevelop, 'admin', 'decor', 'rwxrwsrwx', 'admin', 'decor', 'rw-rw-r--')
    ) else ()
    ,:)
    if (xmldb:collection-available($get:strDecorVersion)) then (
        adpfix:setPermissions($get:strDecorVersion, 'admin', 'decor', 'rwxrwsr-x', 'admin', 'decor', 'rw-r--r--')
        ,
        for $coll in xmldb:get-child-collections($get:strDecorVersion)
        let $devcoll1   := concat($get:strDecorVersion,'/',$coll,'/development')
        let $devcoll2   := concat($get:strDecorVersion,'/',$coll,'/version-development')
        return (
            if (xmldb:collection-available($devcoll1)) then (
                adpfix:setPermissions($devcoll1, 'admin', 'decor', 'rwxrwsr-x', 'admin', 'decor', 'rw-rw-r--')
            ) else (),
            if (xmldb:collection-available($devcoll2)) then (
                adpfix:setPermissions($devcoll2, 'admin', 'decor', 'rwxrwsr-x', 'admin', 'decor', 'rw-rw-r--')
            ) else ()
        )
    ) else ()
    ,
    xmldb:create-collection(string-join(tokenize($get:strDecorTemp,'/')[not(position()=last())],'/'), tokenize($get:strDecorTemp,'/')[last()])
    ,
    adpfix:setPermissions($get:strDecorTemp, 'admin', 'decor', 'rwxrwsrwx', 'admin', 'decor', 'rw-rw-rw-')
    ,
    xmldb:create-collection(string-join(tokenize($get:strDecorScheduledTasks,'/')[not(position()=last())],'/'), tokenize($get:strDecorScheduledTasks,'/')[last()])
    ,
    adpfix:setPermissions($get:strDecorScheduledTasks, 'admin', 'decor', 'rwxrwsr--', 'admin', 'decor', 'rw-rw----')
};

(:
:   Helper function with recursion for adpfix:setDecorPermissions()
:)
declare function adpfix:setPermissions($path as xs:string, $collusrown as xs:string?, $collgrpown as xs:string?, $collmode as xs:string, $resusrown as xs:string?, $resgrpown as xs:string?, $resmode as xs:string) {
    if (string-length($collusrown) = 0) then () else sm:chown(xs:anyURI($path),$collusrown),
    if (string-length($collgrpown) = 0) then () else sm:chgrp(xs:anyURI($path),$collgrpown),
    sm:chmod(xs:anyURI($path),$collmode),
    sm:clear-acl(xs:anyURI($path)),
    for $res in xmldb:get-child-resources(xs:anyURI($path))
    return (
        if (empty($resusrown)) then () else sm:chown(xs:anyURI(concat($path,'/',$res)),$resusrown),
        if (empty($resgrpown)) then () else sm:chgrp(xs:anyURI(concat($path,'/',$res)),$resgrpown),
        sm:chmod(xs:anyURI(concat($path,'/',$res)),$resmode),
        sm:clear-acl(xs:anyURI(concat($path,'/',$res)))
    )
    ,
    for $collection in xmldb:get-child-collections($path)
    return
        adpfix:setPermissions(concat($path,'/',$collection), $collusrown, $collgrpown, $collmode, $resusrown, $resgrpown, $resmode)
};

(:
:   Call to get an overview of permissions in the database. Input may be a collection or a resource. 
:   If it is a collection, all subpaths below that are returned too. The output is a (nested)
:   element sm:permission exactly as sm:get-permissions($path) would return it, but with @path added
:   containing the full path to the collection/resource.
:   Example output:
:   <sm:permission xmlns:sm="http://exist-db.org/xquery/securitymanager" path="/db/apps/art" owner="admin" group="dba" mode="rwxr-xr-x">
        <sm:acl entries="0"/>
        <sm:permission path="/db/apps/art/api" owner="admin" group="dba" mode="rwxr-xr-x">
            <sm:acl entries="0"/>
            <sm:permission path="/db/apps/art/api/api-decor-codesystem.xqm" owner="admin" group="dba" mode="rwxr-xr-x">
                <sm:acl entries="0"/>
            </sm:permission>
            ...
        </sm:permission>
        <sm:permission path="/db/apps/art/build.xml" owner="admin" group="dba" mode="rw-r--r--">
            <sm:acl entries="0"/>
        </sm:permission>
        ...
        <sm:permission path="/db/apps/art/install-data" owner="admin" group="dba" mode="rwxr-xr-x">
            ...
        </sm:permission>
        <sm:permission path="/db/apps/art/modules" owner="admin" group="dba" mode="rwxr-xr-x">
            ...
        </sm:permission>
        ...
        <sm:permission path="/db/apps/art/resources" owner="admin" group="decor" mode="rwxrwxr-x">
            ...
        </sm:permission>
        <sm:permission path="/db/apps/art/xforms" owner="admin" group="dba" mode="rwxr-xr-x">
            ...
        </sm:permission>
    </sm:permission>
:)
declare function adpfix:getCurrentPermissions($path as xs:string) as element(permissions) {
    let $check  := adpfix:checkIfUserDba()
    let $check  :=
        if (xmldb:collection-available($path) or util:binary-doc-available($path) or doc-available($path)) then () else (
            error(QName('http://art-decor.org/ns/art-decor-permissions', 'NotFound'), concat('Supplied path does not exist. ',$path))
        )
    
    let $perm   := sm:get-permissions(xs:anyURI($path))
    return
        <sm:permission path="{$path}">
        {
            $perm/sm:permission/(@* except @path),    (:normally: @owner/@group/@mode:)
            $perm/sm:permission/node(),               (:potential for ACLs <sm:acl entries="0"/>:)
            if (xmldb:collection-available($path)) then (
                for $res in (xmldb:get-child-resources($path) , xmldb:get-child-collections($path))
                order by lower-case($res)
                return
                    adpfix:getCurrentPermissions(concat($path,'/',$res))
            ) else ()
        }
        </sm:permission>
};

(:~ Cleanup compilations if they are not the latest compile for the project - this has a newer counterpart in the API server-mgmt :)
declare function adpfix:cleanupDecorTmp() {
    let $cleanup    :=
        for $decors in collection($get:strDecorTemp)/compile[@compileDate castable as xs:dateTime][@compilationFinished castable as xs:dateTime]
        let $projectPrefix  := $decors/decor/project/@prefix
        group by $projectPrefix
        return (
            let $newest := max($decors/xs:dateTime(@compileDate))
            
            return (
                for $decor in $decors[not(@compileDate = string($newest))]
                return (
                    xmldb:remove(util:collection-name($decor), util:document-name($decor))
                )
            )
        )
    return $cleanup
};

(:~ DELETE all but the newest 3 project runtime compilations - this has a newer counterpart in the API server-mgmt :)
declare function adpfix:cleanupDevelopmentCompilations() as element(compiled)* {
    for $projectPrefix in xmldb:get-child-collections($get:strDecorVersion)
    (: <compiled for="hl7ips-" on="2018-07-09T10:06:14" as="5c49152e-8429-4e59-8bc5-c51293ff70e5" by="Giorgio Cangioli" closed="true" explicitIncludes="true" transactions="" status="active"> :)
    let $compilations   := 
        for $compilation in $get:colDecorVersion//compiled[@for = concat($projectPrefix, '-')][ancestor::compilation]
        order by $compilation/@on descending
        return $compilation
    order by lower-case($projectPrefix)
    return (
        for $ref in subsequence($compilations, 4)/@as
        let $c          := <compiled>{$ref/../@*}</compiled>
        let $del        := 
            try {
                xmldb:remove(concat(util:collection-name($ref), '/', $ref)),
                xmldb:remove(util:collection-name($ref), util:document-name($ref))
            }
            catch * {$c/@as, $err:code, $err:description}
        order by $c/@on
        return
            <compiled>{$c/@*}</compiled>
    )
};

(:~ Apply updates to XForms to support Orbeon 3.9, or 2017 or 2018 that have slightly different functions to call

    To get the forms to work with the newer Orbeon tree controls, we need the following:
    1. Script tag and addition in the model:
        <script xmlns="http://www.w3.org/1999/xhtml" type="text/javascript" src="/apps/fr/resources/scalajs/orbeon-form-runner.js"/>
        <xforms:model ... xxforms:external-events="keydown-pressed keyup-pressed" xxforms:assets.baseline.excludes="/ops/javascript/scalajs/orbeon-xforms.js">
    
    2. Replace all "xxforms:tree with" "tree tree-plus-minus":
        <xforms:select1 ref="instance('concept-navigation')" appearance="tree tree-plus-minus">

       This appears to work too:
        <xforms:select1 ref="instance('concept-navigation')" appearance="xxforms:tree tree tree-plus-minus">

    3. Set orbeon-version in server-info.xml. This allows the xforms to load the right CSS
    
    4. Update jQuery calls. Those are implicitly loaded with Orbeon 3.9 and use $(....) syntax. As of the newer Orbeon 
       version we need to call ORBEON.jQuery(...). The alternative would be to load our own version of jQuery into the
       page, but that has other risks.

    Modus operandi: assume xxforms:tree and $( in script tags is still old style and "tree tree-plus-minus" or ORBEON.jQuery is new style. 
    Assume that any other updates depend on which files have the appropriate marker.
    If status: list all files with old marker as "to-upgrade" and with new marker as "to-downgrade"
    If upgrade: upgrade all files with old marker
    If downgrade: downgrade all files with new marker
:
:   @param $mode        - optional. Default 'status'. Mode: are we going to 'upgrade' to the new tree views, or 'downgrade' to the old
:   @return             - <result time="{current-dateTime()}" total="{count($documents)}" mode="{$mode}">{ <file collection="{$cname[1]}" name="{$fname[1]}" mode="{$mode}"/> } </result>
:   @since 2018-09-21
:)
declare function adpfix:updateXForms($mode as xs:string?) as element(result) {

let $currentVersion := if ($mode = 'status') then $mode else adserver:getServerOrbeonVersion()

let $oldtreemarker := "xxforms:tree"
let $newtreemarker := "tree tree-plus-minus"
let $newscript     := <xhtml:script type="text/javascript" src="/apps/fr/resources/scalajs/orbeon-form-runner.js"/>
let $newattr       := attribute xxforms:assets.baseline.excludes {"/ops/javascript/scalajs/orbeon-xforms.js"}

let $optionsmap     := map:merge((
        map:entry('oldtreemarker', $oldtreemarker),
        map:entry('newtreemarker', $newtreemarker),
        map:entry('newscript', $newscript),
        map:entry('newattr', $newattr)
    ))

(: skip these for safety. decor/core has some xsls we don't want to touch :)
let $collskip                   := map:merge((
        map:entry(concat(repo:get-root(), 'decor/core'), ()),
        map:entry(concat(repo:get-root(), 'dashboard'), ()),
        map:entry(concat(repo:get-root(), 'fundocs'), ()),
        map:entry(concat(repo:get-root(), 'eXide'), ()),
        map:entry(concat(repo:get-root(), 'markdown'), ()),
        map:entry(concat(repo:get-root(), 'monex'), ()),
        map:entry(concat(repo:get-root(), 'shared-resources'), ()),
        map:entry(concat(repo:get-root(), 'usermanager'), ())
    ))

let $candidatesForUpgrade       := collection(repo:get-root())//xforms:select1[@appearance = $oldtreemarker] | collection(repo:get-root())//xhtml:script[contains(., '$(')]
let $candidatesForUpgrade       := $candidatesForUpgrade[not(map:contains($collskip, util:collection-name(.)))]

let $candidatesForDowngrade     := collection(repo:get-root())//xforms:select1[@appearance = $newtreemarker] | collection(repo:get-root())//xhtml:script[contains(., 'ORBEON.jQuery(')]
let $candidatesForDowngrade     := $candidatesForDowngrade[not(map:contains($collskip, util:collection-name(.)))]

let $documentsForDowngrade      := distinct-values(for $n in ($candidatesForDowngrade) return util:document-name($n))
let $documentsForUpgrade        := distinct-values(for $n in ($candidatesForUpgrade) return util:document-name($n))

let $documents                  := 
    switch ($currentVersion)
    case 'status'   return (
        let $label  := concat('suitable-for-', adserver:getServerOrbeonVersion())
        return
        adpfix:doXFormsStatus($candidatesForUpgrade, $label, $optionsmap) | adpfix:doXFormsStatus($candidatesForDowngrade, $label, $optionsmap)
    )
    case '3.9'      return adpfix:doXFormsUpdateFor3.9($candidatesForDowngrade, concat('updated-for-orbeon-', $currentVersion), $optionsmap)
    case '2017'     return adpfix:doXFormsUpdateFor2018($candidatesForUpgrade, concat('updated-for-orbeon-', $currentVersion), $optionsmap) 
    default         return adpfix:doXFormsUpdateFor2018($candidatesForUpgrade, concat('updated-for-orbeon-', $currentVersion), $optionsmap)

return
<result time="{current-dateTime()}" total="{count($documents)}" mode="{$mode}" serverVersion="{adserver:getServerOrbeonVersion()}">
{
    for $d in $documents
    order by $d/@mode descending, $d/@collection, $d/@name
    return
        $d
}
</result>
};

declare %private function adpfix:doXFormsUpdateFor3.9($candidates as element()*, $mode as xs:string, $optionsmap as item()) as element(file)* {
    let $oldtreemarker  := map:get($optionsmap, 'oldtreemarker')
    let $newscript      := map:get($optionsmap, 'newscript')
    let $updatemarker   := update value $candidates/@appearance with $oldtreemarker
    let $updatedoc      := 
        for $docnodes in $candidates/ancestor::*
        let $fname      := util:document-name($docnodes[1])
        let $cname      := util:collection-name($docnodes[1])
        let $path       := string-join(($cname, $fname), '/')
        group by $path
        return (
            <file name="{$fname[1]}" collection="{$cname[1]}" mode="{$mode}"/>
            ,
            for $node in $docnodes
            let $update     := update delete $node//xforms:model/@xxforms:assets.baseline.excludes
            let $update     := update delete $node//xhtml:head/xhtml:script[@src = $newscript/@src]
            let $update     :=
                for $jquerynode in $node//xhtml:script[contains(., 'ORBEON.jQuery(')]
                return
                    update value $jquerynode with replace($jquerynode, 'ORBEON.jQuery\(', '\$(')
            return ()
        )
    return
        $updatedoc
};
declare %private function adpfix:doXFormsUpdateFor2018($candidates as element()*, $mode as xs:string, $optionsmap as item()) as element(file)* {
    let $newtreemarker  := map:get($optionsmap, 'newtreemarker')
    let $newscript      := map:get($optionsmap, 'newscript')
    let $newattr        := map:get($optionsmap, 'newattr')
    let $updatemarker   := update value $candidates/@appearance with $newtreemarker
    let $updatedoc      := 
        for $docnodes in $candidates/ancestor::*
        let $fname      := util:document-name($docnodes[1])
        let $cname      := util:collection-name($docnodes[1])
        let $path       := string-join(($cname, $fname), '/')
        group by $path
        return (
            <file name="{$fname[1]}" collection="{$cname[1]}" mode="{$mode}"/>
            ,
            for $node in $docnodes
            let $update     :=
                if ($node//xforms:model) then
                    if ($node//xforms:model[@xxforms:assets.baseline.excludes = $newattr]) then () else (
                        update insert $newattr into $node//xforms:model
                    )
                else ()
            let $update     := 
                if ($node//xhtml:head) then 
                    if ($node//xhtml:head/xhtml:script[@src = $newscript/@src]) then () else (
                        update insert $newscript preceding $node//xhtml:head/*[1]
                    )
                else ()
            let $update     :=
                for $jquerynode in $node//xhtml:script[contains(., '$(')]
                return
                    update value $jquerynode with replace($jquerynode, '\$\(', 'ORBEON.jQuery(')
            return ()
        )
    return
        $updatedoc
};
declare %private function adpfix:doXFormsStatus($candidates as element()*, $mode as xs:string, $optionsmap as item()) as element(file)* {
    for $docnodes in $candidates/ancestor::*
    let $fname      := util:document-name($docnodes[1])
    let $cname      := util:collection-name($docnodes[1])
    let $path       := string-join((util:collection-name($docnodes), util:document-name($docnodes)), '/')
    group by $path
    return (
        <file collection="{$cname[1]}" name="{$fname[1]}" mode="{$mode}"/>
    )
};

declare %private function adpfix:checkIfUserDba() {
    if (sm:is-dba(get:strCurrentUserName())) then () else (
        error(QName('http://art-decor.org/ns/art-decor-permissions', 'NotAllowed'), concat('Only dba user can use this module. ',get:strCurrentUserName()))
    )
};