From e2696731c0404f69429c10d2dfa536f202ab23e3 Mon Sep 17 00:00:00 2001 From: Jim Wittig Date: Mon, 5 Jan 2026 13:50:04 -0700 Subject: [PATCH 1/2] Ensure the buffer provided to MPAS_io_get_var_generic is large enough. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A fixed size array is provided as an input buffer when reading 0d-char character variables. Call MPAS_io_inq_var prior to the read to get the size of the variable’s value, and only proceed with the read if the variable’s value will fit in the provided array. Return an error code if the variable’s value is larger than the provided input buffer. --- src/framework/mpas_io.F | 62 +++++++++++++++++++++++++++------ src/framework/mpas_io_types.inc | 3 +- 2 files changed, 53 insertions(+), 12 deletions(-) diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index 09514a3667..20318e56ad 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -7,6 +7,9 @@ ! module mpas_io +#define IO_DEBUG_WRITE(M, ARGS) !call mpas_log_write(M, ARGS) +#define IO_ERROR_WRITE(M, ARGS) call mpas_log_write( M, ARGS, messageType=MPAS_LOG_ERR) + use mpas_derived_types use mpas_attlist use mpas_dmpar @@ -1847,6 +1850,13 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr character (len=:), pointer :: charVal_p character (len=:), dimension(:), pointer :: charArray1d_p + ! local variables returned from MPAS_io_inq_var + integer :: fieldtype + integer :: ndims + integer, dimension(:), pointer :: dimsizes + character (len=StrKIND), dimension(:), pointer :: dimnames + character (len=StrKIND) :: message + #ifdef MPAS_SMIOL_SUPPORT type (SMIOLf_decomp), pointer :: null_decomp @@ -1984,22 +1994,41 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr ! call mpas_log_write(' value is char') charVal_p => charVal + + ! get the dimension of the char variable to ensure the provided output buffer is large enough + call MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsizes, local_ierr) + do i = 1, ndims + message = ' MPAS_io_get_var_generic len(charVal):$i var "'//trim(fieldname)// & + '" type is $i dim is $i '// trim(dimnames(i))//' size is $i' + IO_DEBUG_WRITE(message, intArgs=(/len(charVal), fieldtype, i, dimsizes(i)/)) + end do + ! because charVal is provided, assume dimension 1 is the string length + if (dimsizes(1) > len(charVal)) then + local_ierr = MPAS_IO_ERR_INSUFFICIENT_BUF + message = 'Length of string variable "'//trim(fieldname)//'" in file "'//trim(handle % filename)//'"' + IO_ERROR_WRITE(message, intArgs=[0]) + message = ' exceeds buffer size: len('//trim(fieldname)//')=$i, len(buffer)=$i' + IO_ERROR_WRITE(message, intArgs=(/dimsizes(1), len(charVal)/)) + else #ifdef MPAS_SMIOL_SUPPORT - local_ierr = SMIOLf_get_var(handle % smiol_file, trim(fieldname), null_decomp, charVal_p) + local_ierr = SMIOLf_get_var(handle % smiol_file, trim(fieldname), null_decomp, charVal_p) #endif #ifdef MPAS_PIO_SUPPORT - if (field_cursor % fieldhandle % has_unlimited_dim) then - count2(1) = field_cursor % fieldhandle % dims(1) % dimsize - pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start2, count2, tempchar) - charVal(1:count2(1)) = tempchar(1)(1:count2(1)) - else - start1(1) = 1 - count1(1) = field_cursor % fieldhandle % dims(1) % dimsize - pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start1, count1, tempchar) - charVal(1:count1(1)) = tempchar(1)(1:count1(1)) - end if + if (field_cursor % fieldhandle % has_unlimited_dim) then + count2(1) = field_cursor % fieldhandle % dims(1) % dimsize + pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start2, count2, tempchar) + charVal(1:count2(1)) = tempchar(1)(1:count2(1)) + else + start1(1) = 1 + count1(1) = field_cursor % fieldhandle % dims(1) % dimsize + pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start1, count1, tempchar) + charVal(1:count1(1)) = tempchar(1)(1:count1(1)) + end if #endif + end if + deallocate(dimsizes) + deallocate(dimnames) else if (present(charArray1d)) then ! call mpas_log_write(' value is char1') #ifdef MPAS_PIO_SUPPORT @@ -2765,6 +2794,13 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr end if ! call mpas_log_write('Checking for error') + if (local_ierr == MPAS_IO_ERR_INSUFFICIENT_BUF) then + call MPAS_io_err_mesg(handle % ioContext, local_ierr, .false.) + io_global_err = local_ierr + if (present(ierr)) ierr = local_ierr + return + endif + #ifdef MPAS_PIO_SUPPORT if (pio_ierr /= PIO_noerr) then io_global_err = pio_ierr @@ -6498,6 +6534,10 @@ subroutine MPAS_io_err_mesg(ioContext, ierr, fatal) call mpas_log_write('MPAS IO Error: Would clobber existing file', MPAS_LOG_ERR) case (MPAS_IO_ERR_NOEXIST_READ) call mpas_log_write('MPAS IO Error: Attempting to read a file which does not exist.', MPAS_LOG_ERR) + case (MPAS_IO_ERR_MISSING_DIM) + call mpas_log_write('MPAS IO Error: Attempting to read a dimension which does not exist.', MPAS_LOG_ERR) + case (MPAS_IO_ERR_INSUFFICIENT_BUF) + call mpas_log_write('MPAS IO Error: Attempting to read a variable into a buffer of insufficient size.', MPAS_LOG_ERR) case default call mpas_log_write('MPAS IO Error: Unrecognized error code...', MPAS_LOG_ERR) end select diff --git a/src/framework/mpas_io_types.inc b/src/framework/mpas_io_types.inc index 522e6e1ad5..dc7551857a 100644 --- a/src/framework/mpas_io_types.inc +++ b/src/framework/mpas_io_types.inc @@ -65,7 +65,8 @@ MPAS_IO_ERR_UNIMPLEMENTED = -18, & MPAS_IO_ERR_WOULD_CLOBBER = -19, & MPAS_IO_ERR_NOEXIST_READ = -20, & - MPAS_IO_ERR_MISSING_DIM = -21 + MPAS_IO_ERR_MISSING_DIM = -21, & + MPAS_IO_ERR_INSUFFICIENT_BUF = -22 type MPAS_IO_Handle_type logical :: initialized = .false. From 9bdcede0a85c5e4eecbacc406f4084e7308fa4a9 Mon Sep 17 00:00:00 2001 From: Jim Wittig Date: Mon, 5 Jan 2026 14:01:02 -0700 Subject: [PATCH 2/2] Add a test to verify reading character variables won't overrun buffers. Character variables are read into fixed size arrays when reading netcdf files. A test is added which tries to read character variables into a buffer which isn't large enough to hold the data. The test verifies the read fails with a suitable error code. --- src/core_test/Makefile | 5 +- src/core_test/mpas_test_core.F | 13 ++ src/core_test/mpas_test_core_io.F | 200 ++++++++++++++++++++++++++++++ 3 files changed, 216 insertions(+), 2 deletions(-) create mode 100644 src/core_test/mpas_test_core_io.F diff --git a/src/core_test/Makefile b/src/core_test/Makefile index 2d7bb95f1e..e11e5dbb50 100644 --- a/src/core_test/Makefile +++ b/src/core_test/Makefile @@ -12,7 +12,8 @@ OBJS = mpas_test_core.o \ mpas_test_core_dmpar.o \ mpas_test_core_stream_inquiry.o \ mpas_test_openacc.o \ - mpas_test_core_stream_list.o + mpas_test_core_stream_list.o \ + mpas_test_core_io.o all: core_test @@ -44,7 +45,7 @@ mpas_test_core.o: mpas_test_core_halo_exch.o mpas_test_core_streams.o \ mpas_test_core_sorting.o mpas_halo_testing.o \ mpas_test_core_string_utils.o mpas_test_core_dmpar.o \ mpas_test_core_stream_inquiry.o mpas_test_openacc.o \ - mpas_test_core_stream_list.o + mpas_test_core_stream_list.o mpas_test_core_io.o mpas_test_core_halo_exch.o: diff --git a/src/core_test/mpas_test_core.F b/src/core_test/mpas_test_core.F index 2116cbf92a..f0bbc1dda9 100644 --- a/src/core_test/mpas_test_core.F +++ b/src/core_test/mpas_test_core.F @@ -97,6 +97,7 @@ function test_core_run(domain) result(iErr)!{{{ use test_core_string_utils, only : mpas_test_string_utils use mpas_test_core_dmpar, only : mpas_test_dmpar use mpas_test_core_stream_inquiry, only : mpas_test_stream_inquiry + use test_core_io, only : test_core_io_test use mpas_test_core_openacc, only : mpas_test_openacc implicit none @@ -224,6 +225,18 @@ function test_core_run(domain) result(iErr)!{{{ call mpas_stream_mgr_write(domain % streamManager, forceWriteNow=.true.) + ! + ! Run io tests + ! + call mpas_log_write('') + call test_core_io_test(domain, iErr) + if (iErr == 0) then + call mpas_log_write('All tests PASSED') + else + call mpas_log_write('$i tests FAILED', intArgs=[iErr]) + end if + call mpas_log_write('') + ! ! Run mpas_test_openacc ! diff --git a/src/core_test/mpas_test_core_io.F b/src/core_test/mpas_test_core_io.F new file mode 100644 index 0000000000..b448d06d78 --- /dev/null +++ b/src/core_test/mpas_test_core_io.F @@ -0,0 +1,200 @@ +! Copyright (c) 2025 The University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at https://mpas-dev.github.io/license.html . +! +module test_core_io + +#define ERROR_WRITE(M) call mpas_log_write( M , messageType=MPAS_LOG_ERR) +#define ERROR_WRITE_ARGS(M, ARGS) call mpas_log_write( M , ARGS, messageType=MPAS_LOG_ERR) + use mpas_log + use mpas_io + + implicit none + private + public :: test_core_io_test + + contains + + !*********************************************************************** + ! + ! routine close_file_with_message + ! + !> \brief closes the provided file handle and writes an error message. + !----------------------------------------------------------------------- + subroutine close_file_with_message(fileHandle, message, args) + type(MPAS_IO_Handle_type), intent(inout) :: fileHandle + character (len=*), intent(in), optional :: message + integer, dimension(:), intent(in), optional :: args + + integer :: local_ierr + + ! log an error message + if (present(message)) then + ERROR_WRITE_ARGS(message, intArgs=args) + end if + + ! close the provided file + call MPAS_io_close(fileHandle, local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ERROR_WRITE_ARGS('MPAS_io_close failed with error code:$i', intArgs=(/local_ierr/)) + return + endif + + end subroutine close_file_with_message + + !*********************************************************************** + ! + ! routine test_read_string_buffer_check + ! + !> \brief verifies attempts to read strings into buffers which are too small + !> to hold the value fails safely. + !> \details + !> Run these tests with valgrind to ensure there are no buffer overflows when + !> attempting to read strings into undersized buffers. + !----------------------------------------------------------------------- + subroutine test_read_string_buffer_check(domain, ierr) + + type (domain_type), intent(inout) :: domain + integer, intent(out) :: ierr + + integer :: local_ierr, i + type(MPAS_IO_Handle_type) :: fileHandle + character (len=StrKIND), dimension(1), parameter :: dimNamesString = ['StrLen'] + character (len=StrKIND), dimension(2), parameter :: dimNamesStringTime = & + [character(len=StrKIND) :: 'StrLen', 'Time'] + character (len=32), parameter :: varName1 = 'stringVar' + character (len=32), parameter :: varName2 = 'stringTimeVar' + character (len=*), parameter :: varValue1 = 'This is a string' + character (len=32), dimension(2), parameter :: varNames = [varName1, varName2] + integer, parameter :: bufferSize=128 + integer, parameter :: smallBufferSize=bufferSize/2 + character (len=bufferSize) :: buffer + character (len=smallBufferSize) :: smallBuffer + character (len=*), parameter :: filename = 'char_data.nc' + + ierr = 0 + + ! open a file to write char variables to + fileHandle = MPAS_io_open(filename, MPAS_IO_WRITE, MPAS_IO_NETCDF, domain % ioContext, & + clobber_file=.true., truncate_file=.true., ierr=local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + ERROR_WRITE('Error opening file ' // trim(filename)) + return + end if + + ! define dimensions and char variables + call MPAS_io_def_dim(fileHandle, dimNamesStringTime(1), bufferSize, local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error defining '//trim(dimNamesStringTime(1))//', error=$i', (/local_ierr/)) + return + end if + call MPAS_io_def_dim(fileHandle, dimNamesStringTime(2), MPAS_IO_UNLIMITED_DIM, local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error defining '//trim(dimNamesStringTime(2))//', error=$i', (/local_ierr/)) + return + end if + call MPAS_io_def_var(fileHandle, varNames(1), MPAS_IO_CHAR, dimNamesString, ierr=local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error defining var "'//trim(varNames(1))//'" error=$i', (/local_ierr/)) + return + end if + call MPAS_io_def_var(fileHandle, varNames(2), MPAS_IO_CHAR, dimNamesStringTime, ierr=local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error defining var "'//trim(varNames(2))//'" error=$i', (/local_ierr/)) + return + end if + + ! write the string values + do i=1,size(varNames) + call MPAS_io_put_var_char0d(fileHandle, varNames(i), varValue1, local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error writing "'//trim(varNames(i))// & + '", error=$i', (/local_ierr/)) + return + end if + + ! verify the strings are read into buffers which are large enough for the string values + call MPAS_io_get_var_char0d(fileHandle, varNames(i), buffer, local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error reading "'//trim(varNames(i))// & + '", error=$i', (/local_ierr/)) + return + end if + end do + + ! verify attempts to read strings into buffers which are too small generates an error + call mpas_log_write(' ') + call mpas_log_write('Expect to see the following error:') + call MPAS_io_err_mesg(domain % ioContext, MPAS_IO_ERR_INSUFFICIENT_BUF, .false.) + call mpas_log_write(' ') + do i=1,size(varNames) + ! this should return an error + call MPAS_io_get_var_char0d(fileHandle, varNames(i), smallBuffer, local_ierr) + call mpas_log_write(' ') + + if (local_ierr /= MPAS_IO_ERR_INSUFFICIENT_BUF) then + ierr = 1 + if (local_ierr == MPAS_IO_NOERR) then + call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_BUF ($i)'& + //' but recieved no error reading "'//trim(varName1), (/local_ierr/)) + else + call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_BUF ($i)'& + //' but recieved error $i reading "'//trim(varName1)//'"', & + (/MPAS_IO_ERR_INSUFFICIENT_BUF, local_ierr/)) + end if + return + end if + end do + call close_file_with_message(fileHandle) + + end subroutine test_read_string_buffer_check + + + !*********************************************************************** + ! Subroutine test_core_io_test + ! + !> \brief Core test suite for I/O + !> + !> \details This subroutine tests mpas_io features. + !> It calls individual tests for I/O operations. + !> See the subroutine body for details. + !> The results of each test are logged with a success or failure message. + !> + !> \param domain The domain object that contains the I/O context + !> \param ierr The error code that indicates the result of the test. + ! + !----------------------------------------------------------------------- + subroutine test_core_io_test(domain, ierr) + + use mpas_log + + type (domain_type), intent(inout) :: domain + integer, intent(out) :: ierr + + integer :: test_status + + ierr = 0 + test_status = 0 + + call mpas_log_write('Testing char-0 buffer reads') + call test_read_string_buffer_check(domain, test_status) + if (test_status == 0) then + call mpas_log_write('char-0 buffer tests: SUCCESS') + else + call mpas_log_write('char-0 buffer tests: FAILURE', MPAS_LOG_ERR) + ierr = ierr + abs(test_status) + end if + + + end subroutine test_core_io_test + +end module test_core_io