Skip to content

Commit 3d97db2

Browse files
jim-p-wjim-p-w
committed
Ensure the buffer provided to MPAS_io_get_var_generic is large enough.
A fixed size array is provided as an output buffer when reading a 0d-char character variable. Call MPAS_io_inq_var prior to the read to get the size of the variable, and only proceed with the read if the size of the variable will fit in the provided array. Return an error code if the variable value is larger than the provided output buffer.
1 parent 55c737f commit 3d97db2

File tree

5 files changed

+308
-29
lines changed

5 files changed

+308
-29
lines changed

‎src/core_test/Makefile‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,8 @@ OBJS = mpas_test_core.o \
1212
mpas_test_core_dmpar.o \
1313
mpas_test_core_stream_inquiry.o \
1414
mpas_test_openacc.o \
15-
mpas_test_core_stream_list.o
15+
mpas_test_core_stream_list.o \
16+
mpas_test_core_io.o \
1617

1718
all: core_test
1819

‎src/core_test/mpas_test_core.F‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -97,6 +97,7 @@ function test_core_run(domain) result(iErr)!{{{
9797
use test_core_string_utils, only : mpas_test_string_utils
9898
use mpas_test_core_dmpar, only : mpas_test_dmpar
9999
use mpas_test_core_stream_inquiry, only : mpas_test_stream_inquiry
100+
use test_core_io, only : test_core_io_test
100101
use mpas_test_core_openacc, only : mpas_test_openacc
101102

102103
implicit none
@@ -224,6 +225,17 @@ function test_core_run(domain) result(iErr)!{{{
224225

225226
call mpas_stream_mgr_write(domain % streamManager, forceWriteNow=.true.)
226227

228+
!
229+
! Run io tests
230+
!
231+
call mpas_log_write('')
232+
call test_core_io_test(domain, threadErrs, iErr)
233+
if (iErr == 0) then
234+
call mpas_log_write('All tests PASSED')
235+
else
236+
call mpas_log_write('$i tests FAILED', intArgs=[iErr])
237+
end if
238+
call mpas_log_write('')
227239
!
228240
! Run mpas_test_openacc
229241
!

‎src/core_test/mpas_test_core_io.F‎

Lines changed: 228 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,228 @@
1+
! Copyright (c) 2013, Los Alamos National Security, LLC (LANS)
2+
! and the University Corporation for Atmospheric Research (UCAR).
3+
!
4+
! Unless noted otherwise source code is licensed under the BSD license.
5+
! Additional copyright and license information can be found in the LICENSE file
6+
! distributed with this code, or at http://mpas-dev.github.com/license.html
7+
!
8+
module test_core_io
9+
10+
#define ERROR_WRITE(M) call mpas_log_write( M , messageType=MPAS_LOG_ERR)
11+
#define ERROR_WRITE_ARGS(M, ARGS) call mpas_log_write( M , ARGS, messageType=MPAS_LOG_ERR)
12+
use mpas_log
13+
use mpas_io
14+
15+
implicit none
16+
private
17+
public :: test_core_io_test
18+
19+
contains
20+
21+
!***********************************************************************
22+
!
23+
! routine close_file_with_message
24+
!
25+
!> \brief closes the provided file handle and writes an error message.
26+
!-----------------------------------------------------------------------
27+
subroutine close_file_with_message(fileHandle, message, args, delete)
28+
type(MPAS_IO_Handle_type), intent(inout) :: fileHandle
29+
character (len=*), intent(in), optional :: message
30+
integer, dimension(:), intent(in), optional :: args
31+
logical, intent(in), optional :: delete
32+
33+
integer :: local_ierr
34+
35+
! log an error message
36+
if (present(message)) then
37+
if (present(args)) then
38+
ERROR_WRITE_ARGS(message, intArgs=args)
39+
else
40+
ERROR_WRITE(message)
41+
end if
42+
end if
43+
44+
! close the provided file
45+
call MPAS_io_close(fileHandle, local_ierr)
46+
if (local_ierr /= MPAS_IO_NOERR) then
47+
ERROR_WRITE_ARGS('MPAS_io_close failed with error code:$i', intArgs=(/local_ierr/))
48+
return
49+
endif
50+
51+
end subroutine close_file_with_message
52+
53+
!***********************************************************************
54+
!
55+
! routine delete_file
56+
!
57+
!> \brief deletes the provided file
58+
!-----------------------------------------------------------------------
59+
subroutine delete_file(filename)
60+
character (len=*), intent(in) :: filename
61+
62+
logical :: exists
63+
integer :: io, stat
64+
inquire(file=filename, exist=exists)
65+
if (exists) then
66+
open(file=filename, newunit=io, iostat=stat)
67+
if (stat == 0) close(io, status="delete", iostat=stat)
68+
end if
69+
70+
end subroutine delete_file
71+
72+
!***********************************************************************
73+
!
74+
! routine test_read_string_buffer_check
75+
!
76+
!> \brief verifies attempts to read strings into buffers which are too small
77+
!> to hold the value fails safely.
78+
!> \details
79+
!> Run these tests with valgrind to ensure there are no buffer overflows when
80+
!> attempting to read strings into undersized buffers.
81+
!-----------------------------------------------------------------------
82+
subroutine test_read_string_buffer_check(domain, threadErrs, ierr)
83+
84+
type (domain_type), intent(inout) :: domain
85+
integer, dimension(:), intent(out) :: threadErrs
86+
integer, intent(out) :: ierr
87+
88+
integer :: local_ierr, i
89+
type(MPAS_IO_Handle_type) :: fileHandle
90+
character (len=StrKIND), dimension(1), parameter :: dimNamesString = ['StrLen']
91+
character (len=StrKIND), dimension(2), parameter :: dimNamesStringTime = ['StrLen', 'Time ']
92+
character (len=32), parameter :: varName1 = 'stringVar'
93+
character (len=32), parameter :: varName2 = 'stringTimeVar'
94+
character (len=*), parameter :: varValue1 = 'This is a string'
95+
character (len=32), dimension(2), parameter :: varNames = [varName1, varName2]
96+
integer, parameter :: bufferSize=128
97+
integer, parameter :: smallBufferSize=bufferSize/2
98+
character (len=bufferSize) :: buffer
99+
character (len=smallBufferSize) :: smallBuffer
100+
character (len=*), parameter :: filename = 'char_data.nc'
101+
102+
ierr = 0
103+
104+
! open a file to write char variables to
105+
fileHandle = MPAS_io_open(filename, MPAS_IO_WRITE, MPAS_IO_NETCDF, domain % ioContext, &
106+
clobber_file=.true., truncate_file=.true., ierr=local_ierr)
107+
if (local_ierr /= MPAS_IO_NOERR) then
108+
ierr = 1
109+
ERROR_WRITE('Error opening file ' // trim(filename))
110+
return
111+
end if
112+
113+
! define dimensions and char variables
114+
call MPAS_io_def_dim(fileHandle, dimNamesStringTime(1), bufferSize, local_ierr)
115+
if (local_ierr /= MPAS_IO_NOERR) then
116+
ierr = 1
117+
call close_file_with_message(fileHandle, 'Error defining '//trim(dimNamesStringTime(1))//', error=$i', (/local_ierr/))
118+
return
119+
end if
120+
call MPAS_io_def_dim(fileHandle, dimNamesStringTime(2), MPAS_IO_UNLIMITED_DIM, local_ierr)
121+
if (local_ierr /= MPAS_IO_NOERR) then
122+
ierr = 1
123+
call close_file_with_message(fileHandle, 'Error defining '//trim(dimNamesStringTime(2))//', error=$i', (/local_ierr/))
124+
return
125+
end if
126+
call MPAS_io_def_var(fileHandle, varNames(1), MPAS_IO_CHAR, dimNamesString, ierr=local_ierr)
127+
if (local_ierr /= MPAS_IO_NOERR) then
128+
ierr = 1
129+
call close_file_with_message(fileHandle, 'Error defining var "'//trim(varNames(1))//'" error=$i', (/local_ierr/))
130+
return
131+
end if
132+
call MPAS_io_def_var(fileHandle, varNames(2), MPAS_IO_CHAR, dimNamesStringTime, ierr=local_ierr)
133+
if (local_ierr /= MPAS_IO_NOERR) then
134+
ierr = 1
135+
call close_file_with_message(fileHandle, 'Error defining var "'//trim(varNames(2))//'" error=$i', (/local_ierr/))
136+
return
137+
end if
138+
139+
! write the string values
140+
do i=1,2
141+
call MPAS_io_put_var_char0d(fileHandle, varNames(i), varValue1, local_ierr)
142+
if (local_ierr /= MPAS_IO_NOERR) then
143+
ierr = 1
144+
call close_file_with_message(fileHandle, 'Error writing '//trim(varName1)//', error=$i', (/local_ierr/))
145+
return
146+
end if
147+
148+
! verify the strings are read into buffers which are large enough for the strin values
149+
call MPAS_io_get_var_char0d(fileHandle, varNames(i), buffer, local_ierr)
150+
if (local_ierr /= MPAS_IO_NOERR) then
151+
ierr = 1
152+
call close_file_with_message(fileHandle, 'Error reading '//trim(varName1)//', error=$i', (/local_ierr/))
153+
return
154+
end if
155+
end do
156+
157+
! verify attempts to read strings into buffers which are too small generates an error
158+
call mpas_log_write(' ')
159+
call mpas_log_write('Expect to see the following error:')
160+
call MPAS_io_err_mesg(domain % ioContext, MPAS_IO_ERR_INSUFFICIENT_ARG, .false.)
161+
call mpas_log_write(' ')
162+
do i=1,2
163+
! this should return an error
164+
call MPAS_io_get_var_char0d(fileHandle, varNames(i), smallBuffer, local_ierr)
165+
call mpas_log_write(' ')
166+
167+
if (local_ierr /= MPAS_IO_ERR_INSUFFICIENT_ARG) then
168+
ierr = 1
169+
if (local_ierr == MPAS_IO_NOERR) then
170+
call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_ARG ($i) but recieved' &
171+
//' no error reading '//trim(varName1), &
172+
(/local_ierr/))
173+
else
174+
call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_ARG ($i) but recieved' &
175+
//' error $i reading '//trim(varName1)//', var size=$i, buffer size=$i', &
176+
(/MPAS_IO_ERR_INSUFFICIENT_ARG, local_ierr/))
177+
end if
178+
return
179+
end if
180+
end do
181+
call close_file_with_message(fileHandle, delete=.true.)
182+
call delete_file(filename)
183+
184+
end subroutine test_read_string_buffer_check
185+
186+
187+
!***********************************************************************
188+
! Subroutine test_core_io_test
189+
!
190+
!> \brief Core test suite for I/O
191+
!>
192+
!> \details This subroutine tests mpas_io features.
193+
!> It calls individual tests for I/O operations.
194+
!> See the subroutine body for details.
195+
!> The results of each test are logged with a success or failure message.
196+
!>
197+
!> \param domain The domain object that contains the I/O context
198+
!> \param threadErrs An array to store any errors encountered during
199+
!> the test.
200+
!> \param ierr The error code that indicates the result of the test.
201+
!
202+
!-----------------------------------------------------------------------
203+
subroutine test_core_io_test(domain, threadErrs, ierr)
204+
205+
use mpas_log
206+
207+
type (domain_type), intent(inout) :: domain
208+
integer, dimension(:), intent(out) :: threadErrs
209+
integer, intent(out) :: ierr
210+
211+
integer :: test_status
212+
213+
ierr = 0
214+
test_status = 0
215+
216+
call mpas_log_write('Testing char-0 buffer reads')
217+
call test_read_string_buffer_check(domain, threadErrs, test_status)
218+
if (test_status == 0) then
219+
call mpas_log_write('char-0 buffer tests: SUCCESS')
220+
else
221+
call mpas_log_write('char-0 buffer tests: FAILURE', MPAS_LOG_ERR)
222+
ierr = ierr + abs(test_status)
223+
end if
224+
225+
226+
end subroutine test_core_io_test
227+
228+
end module test_core_io

0 commit comments

Comments
 (0)