Merge pull request #309 from sabracrolleton/master

Fix bug in drop-roles where role did not have login right

postmodern/roles.lisp

@@ -40,7 +40,7 @@ In PostgreSQL*, you cannot drop a database while clients are connected to it.
 |#
 
 (defun list-database-users ()
-  "List database users (actually 'roles' in Postgresql terminology)."
+  "List database users (Roles who can login)."
   (alexandria:flatten (query (:order-by
                               (:select 'usename :from 'pg_user)
                               'usename))))
@@ -440,19 +440,20 @@ group roles."
                                :port (cl-postgres::connection-port *database*)
                                :use-ssl (cl-postgres::connection-use-ssl *database*))
           (when (and (not (string= role-name "postgres"))
-                     (member role-name (list-database-users) :test #'equal))
+                     (role-exists-p role-name))
             (query (format nil "reassign owned by ~a to ~a" role-name new-owner))
-            (query (format nil "drop owned by ~a" role-name)))))
+            (query (format nil "drop owned by ~a" role-name))
+            (query (format nil "drop role if exists ~a" role-name)))))
       (with-connection (list database (cl-postgres::connection-user *database*)
                              (cl-postgres::connection-password *database*)
                              (cl-postgres::connection-host *database*)
                              :port (cl-postgres::connection-port *database*)
                              :use-ssl (cl-postgres::connection-use-ssl *database*))
         (when (and (not (string= role-name "postgres"))
-                   (member role-name (list-database-users) :test #'equal))
+                   (role-exists-p role-name))
           (query (format nil "reassign owned by ~a to ~a" role-name new-owner))
-          (query (format nil "drop owned by ~a" role-name)))))
-      (query (format nil "drop role if exists ~a" role-name))
+          (query (format nil "drop owned by ~a cascade" role-name))
+          (query (format nil "drop role if exists ~a" role-name)))))
       (not (role-exists-p role-name)))
 
 (defun list-role-permissions (&optional role)

postmodern/tests/test-roles.lisp

@@ -89,11 +89,12 @@
     (let ((superuser-name (cl-postgres::connection-user *database*))
           (superuser-password (cl-postgres::connection-password *database*))
           (host (cl-postgres::connection-host *database*))
-          (dbs *test-dbs*)
+          ;;This is not limited to the test dbs intentionally because some of the created roles
+          ;; may end up with objects owned in other dbs on the test machine.
+          (dbs (list-databases :names-only t))
           (users (intersection *test-roles*
                                (list-database-users) :test #'equal))
           (port (cl-postgres::connection-port *database*)))
-      (format t "dbs ~a ~%" dbs)
       (loop for x in dbs do
         (when (database-exists-p x)
           (with-connection (list x superuser-name superuser-password host :port port)
@@ -102,7 +103,9 @@
                      (query (format nil "drop owned by ~a" y))))))
       (loop for x in users do (drop-role x))
       (loop for x in dbs do
-        (when (database-exists-p x) (drop-database x))))))
+        (when (and (database-exists-p x)
+                   (not (equal x "test")))
+          (drop-database x))))))
 
 (defun test-db-creation-helper ()
   "These tables get created for every db created"
@@ -165,9 +168,9 @@
             (test-db-creation-helper)))))))
 
 (test create-db-role-0-1
-  (clean-test)
-  (create-role-test-dbs)
   (with-test-connection
+    (clean-test)
+    (create-role-test-dbs)
     (let ((port (cl-postgres::connection-port *database*)))
       (is (equal (generate-test-table-row "d1" "readonly_d_all_s_public_t_all" "public" "t3"
                                           port)
@@ -321,14 +324,14 @@
 
 (test default-privileges-1
   (with-test-connection
-      (let ((port (cl-postgres::connection-port *database*))
-            (superuser-name (cl-postgres::connection-user *database*)))
+    (let ((port (cl-postgres::connection-port *database*))
+          (superuser-name (cl-postgres::connection-user *database*)))
       (when (schema-exists-p "a")
         (drop-schema "a" :cascade t))
       (when (schema-exists-p "b")
         (drop-schema "b" :cascade t))
-      (when (role-exists-p "a") (drop-role "a" superuser-name))
-      (when (role-exists-p "b") (drop-role "b" superuser-name))
+      (when (role-exists-p "a") (drop-role "a" superuser-name "test"))
+      (when (role-exists-p "b") (drop-role "b" superuser-name "test"))
       (create-role "a" "a")
       (create-schema "a" "a")
       (alter-role-search-path "a" "a")
@@ -362,46 +365,52 @@
         (query "create table t4 as select * from t1"))
       (with-connection `("test" "b" "b" "localhost" :port ,port)
         (is (equal (query (:select (:count '*) :from 'a.t4) :single)
-                   1))))))
+                   1)))
+      (with-test-connection
+        (when (role-exists-p "a") (drop-role "a" superuser-name "test"))
+        (when (role-exists-p "b") (drop-role "b" superuser-name "test"))))))
 
 (test default-privileges-2
   (with-test-connection
-      (let ((port (cl-postgres::connection-port *database*))
-            (superuser-name (cl-postgres::connection-user *database*)))
-    (when (schema-exists-p "a")
-      (drop-schema "a" :cascade t))
-    (when (schema-exists-p "b")
-      (drop-schema "b" :cascade t))
-    (when (role-exists-p "a") (drop-role "a" superuser-name))
-    (when (role-exists-p "b") (drop-role "b" superuser-name))
-    (create-role "a" "a")
-    (create-schema "a" "a")
-    (alter-role-search-path "a" "a")
-    (create-role "b" "b")
-    (create-schema "b" "b")
-    (alter-role-search-path "b" "b")
-    (with-connection `("test" "a" "a" "localhost" :port ,port)
-      (query (:create-table 't1 ((a :type integer))))
-      (query (:insert-into 't1 :set 'a 1)))
-    (with-connection `("test" "b" "b" "localhost" :port ,port)
-      (signals error (query (:select (:count '*) :from 'a.t1))))
-    (with-connection `("test" "a" "a" "localhost" :port ,port)
-      (pomo:grant-readonly-permissions "a" "b"))
-    (with-connection `("test" "b" "b" "localhost" :port ,port)
-      (is (equal (query (:select (:count '*) :from 'a.t1) :single)
-                 1)))
-    (with-connection `("test" "a" "a" "localhost" :port ,port)
-      (query "create table t3 as select * from t1"))
-    (with-connection `("test" "b" "b" "localhost" :port ,port)
-      (is (equal (query (:select (:count '*) :from 'a.t1) :single)
-                 1)))
-    (with-connection `("test" "b" "b" "localhost" :port ,port)
-      (signals error (query (:insert-into 'a.t1 :set 'a 2)))
-      (signals error (query (:update 'a.t1 :set 'a 3 :where (:= 'a 1)))))
-    (with-connection `("test" "a" "a" "localhost" :port ,port)
-      (pomo:grant-editor-permissions "a" "b"))
-    (with-connection `("test" "b" "b" "localhost" :port ,port)
-      (query (:insert-into 'a.t1 :set 'a 2))
-      (query (:update 'a.t1 :set 'a 3 :where (:= 'a 1)))
-      (is (equal (query (:select 'a :from 'a.t1 :where (:= 'a 3)) :single)
-                 3))))))
+    (let ((port (cl-postgres::connection-port *database*))
+          (superuser-name (cl-postgres::connection-user *database*)))
+      (when (schema-exists-p "a")
+        (drop-schema "a" :cascade t))
+      (when (schema-exists-p "b")
+        (drop-schema "b" :cascade t))
+      (when (role-exists-p "a") (drop-role "a" superuser-name "test"))
+      (when (role-exists-p "b") (drop-role "b" superuser-name "test"))
+      (create-role "a" "a")
+      (create-schema "a" "a")
+      (alter-role-search-path "a" "a")
+      (create-role "b" "b")
+      (create-schema "b" "b")
+      (alter-role-search-path "b" "b")
+      (with-connection `("test" "a" "a" "localhost" :port ,port)
+        (query (:create-table 't1 ((a :type integer))))
+        (query (:insert-into 't1 :set 'a 1)))
+      (with-connection `("test" "b" "b" "localhost" :port ,port)
+        (signals error (query (:select (:count '*) :from 'a.t1))))
+      (with-connection `("test" "a" "a" "localhost" :port ,port)
+        (pomo:grant-readonly-permissions "a" "b"))
+      (with-connection `("test" "b" "b" "localhost" :port ,port)
+        (is (equal (query (:select (:count '*) :from 'a.t1) :single)
+                   1)))
+      (with-connection `("test" "a" "a" "localhost" :port ,port)
+        (query "create table t3 as select * from t1"))
+      (with-connection `("test" "b" "b" "localhost" :port ,port)
+        (is (equal (query (:select (:count '*) :from 'a.t1) :single)
+                   1)))
+      (with-connection `("test" "b" "b" "localhost" :port ,port)
+        (signals error (query (:insert-into 'a.t1 :set 'a 2)))
+        (signals error (query (:update 'a.t1 :set 'a 3 :where (:= 'a 1)))))
+      (with-connection `("test" "a" "a" "localhost" :port ,port)
+        (pomo:grant-editor-permissions "a" "b"))
+      (with-connection `("test" "b" "b" "localhost" :port ,port)
+        (query (:insert-into 'a.t1 :set 'a 2))
+        (query (:update 'a.t1 :set 'a 3 :where (:= 'a 1)))
+        (is (equal (query (:select 'a :from 'a.t1 :where (:= 'a 3)) :single)
+                   3)))
+      (with-test-connection
+        (when (role-exists-p "a") (drop-role "a" superuser-name "test"))
+        (when (role-exists-p "b") (drop-role "b" superuser-name "test"))))))