1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1999-2009 Oracle.  All rights reserved.
4#
5# $Id$
6#
7# TEST	test063
8# TEST	Test of the DB_RDONLY flag to DB->open
9# TEST	Attempt to both DB->put and DBC->c_put into a database
10# TEST	that has been opened DB_RDONLY, and check for failure.
11proc test063 { method args } {
12	global errorCode
13	source ./include.tcl
14
15	set args [convert_args $method $args]
16	set omethod [convert_method $method]
17	set tnum "063"
18
19	set txnenv 0
20	set eindex [lsearch -exact $args "-env"]
21	#
22	# If we are using an env, then testfile should just be the db name.
23	# Otherwise it is the test directory and the name.
24	if { $eindex == -1 } {
25		set testfile $testdir/test$tnum.db
26		set env NULL
27	} else {
28		set testfile test$tnum.db
29		incr eindex
30		set env [lindex $args $eindex]
31		set txnenv [is_txnenv $env]
32		if { $txnenv == 1 } {
33			append args " -auto_commit "
34		}
35		set testdir [get_home $env]
36	}
37	cleanup $testdir $env
38
39	set key "key"
40	set data "data"
41	set key2 "another_key"
42	set data2 "more_data"
43
44	set gflags ""
45	set txn ""
46
47	if { [is_record_based $method] == 1 } {
48	    set key "1"
49	    set key2 "2"
50	    append gflags " -recno"
51	}
52
53	puts "Test$tnum: $method ($args) DB_RDONLY test."
54
55	# Create a test database.
56	puts "\tTest$tnum.a: Creating test database."
57	set db [eval {berkdb_open_noerr -create -mode 0644} \
58	    $omethod $args $testfile]
59	error_check_good db_create [is_valid_db $db] TRUE
60
61	# Put and get an item so it's nonempty.
62	if { $txnenv == 1 } {
63		set t [$env txn]
64		error_check_good txn [is_valid_txn $t $env] TRUE
65		set txn "-txn $t"
66	}
67	set ret [eval {$db put} $txn {$key [chop_data $method $data]}]
68	error_check_good initial_put $ret 0
69
70	set dbt [eval {$db get} $txn $gflags {$key}]
71	error_check_good initial_get $dbt \
72	    [list [list $key [pad_data $method $data]]]
73
74	if { $txnenv == 1 } {
75		error_check_good txn [$t commit] 0
76	}
77	error_check_good db_close [$db close] 0
78
79	if { $eindex == -1 } {
80		# Confirm that database is writable.  If we are
81		# using an env (that may be remote on a server)
82		# we cannot do this check.
83		error_check_good writable [file writable $testfile] 1
84	}
85
86	puts "\tTest$tnum.b: Re-opening DB_RDONLY and attempting to put."
87
88	# Now open it read-only and make sure we can get but not put.
89	set db [eval {berkdb_open_noerr -rdonly} $args {$testfile}]
90	error_check_good db_open [is_valid_db $db] TRUE
91
92	if { $txnenv == 1 } {
93		set t [$env txn]
94		error_check_good txn [is_valid_txn $t $env] TRUE
95		set txn "-txn $t"
96	}
97	set dbt [eval {$db get} $txn $gflags {$key}]
98	error_check_good db_get $dbt \
99	    [list [list $key [pad_data $method $data]]]
100
101	set ret [catch {eval {$db put} $txn \
102	    {$key2 [chop_data $method $data]}} res]
103	error_check_good put_failed $ret 1
104	error_check_good db_put_rdonly [is_substr $errorCode "EACCES"] 1
105	if { $txnenv == 1 } {
106		error_check_good txn [$t commit] 0
107	}
108
109	set errorCode "NONE"
110
111	puts "\tTest$tnum.c: Attempting cursor put."
112
113	if { $txnenv == 1 } {
114		set t [$env txn]
115		error_check_good txn [is_valid_txn $t $env] TRUE
116		set txn "-txn $t"
117	}
118	set dbc [eval {$db cursor} $txn]
119	error_check_good cursor_create [is_valid_cursor $dbc $db] TRUE
120
121	error_check_good cursor_set [$dbc get -first] $dbt
122	set ret [catch {eval {$dbc put} -current $data} res]
123	error_check_good c_put_failed $ret 1
124	error_check_good dbc_put_rdonly [is_substr $errorCode "EACCES"] 1
125
126	set dbt [eval {$db get} $gflags {$key2}]
127	error_check_good db_get_key2 $dbt ""
128
129	puts "\tTest$tnum.d: Attempting ordinary delete."
130
131	set errorCode "NONE"
132	set ret [catch {eval {$db del} $txn {$key}} 1]
133	error_check_good del_failed $ret 1
134	error_check_good db_del_rdonly [is_substr $errorCode "EACCES"] 1
135
136	set dbt [eval {$db get} $txn $gflags {$key}]
137	error_check_good db_get_key $dbt \
138	    [list [list $key [pad_data $method $data]]]
139
140	puts "\tTest$tnum.e: Attempting cursor delete."
141	# Just set the cursor to the beginning;  we don't care what's there...
142	# yet.
143	set dbt2 [$dbc get -first]
144	error_check_good db_get_first_key $dbt2 $dbt
145	set errorCode "NONE"
146	set ret [catch {$dbc del} res]
147	error_check_good c_del_failed $ret 1
148	error_check_good dbc_del_rdonly [is_substr $errorCode "EACCES"] 1
149
150	set dbt2 [$dbc get -current]
151	error_check_good db_get_key $dbt2 $dbt
152
153	puts "\tTest$tnum.f: Close, reopen db;  verify unchanged."
154
155	error_check_good dbc_close [$dbc close] 0
156	if { $txnenv == 1 } {
157		error_check_good txn [$t commit] 0
158	}
159	error_check_good db_close [$db close] 0
160
161	set db [eval {berkdb_open} $omethod $args $testfile]
162	error_check_good db_reopen [is_valid_db $db] TRUE
163
164	set dbc [$db cursor]
165	error_check_good cursor_create [is_valid_cursor $dbc $db] TRUE
166
167	error_check_good first_there [$dbc get -first] \
168	    [list [list $key [pad_data $method $data]]]
169	error_check_good nomore_there [$dbc get -next] ""
170
171	error_check_good dbc_close [$dbc close] 0
172	error_check_good db_close [$db close] 0
173}
174