fortsh Public

Watch 0 Fork 0 Star 0
Fortran · 10626 bytes Raw Blame History
1 ! ==============================================================================
2 ! Module: error_handling
3 ! Purpose: Comprehensive error handling and logging for fortsh
4 ! ==============================================================================
5 module error_handling
6 use iso_fortran_env, only: output_unit, error_unit
7 implicit none
8
9 ! Error severity levels
10 integer, parameter :: ERR_DEBUG = 0
11 integer, parameter :: ERR_INFO = 1
12 integer, parameter :: ERR_WARN = 2
13 integer, parameter :: ERR_ERROR = 3
14 integer, parameter :: ERR_FATAL = 4
15
16 ! Error categories
17 integer, parameter :: ERR_CAT_PARSER = 100
18 integer, parameter :: ERR_CAT_EXECUTOR = 200
19 integer, parameter :: ERR_CAT_SYSTEM = 300
20 integer, parameter :: ERR_CAT_IO = 400
21 integer, parameter :: ERR_CAT_MEMORY = 500
22
23 ! Global error handling state
24 logical :: debug_mode = .false.
25 logical :: verbose_errors = .true.
26 integer :: max_error_count = 50
27 integer :: error_count = 0
28
29 type :: error_info_t
30 integer :: severity
31 integer :: category
32 integer :: code
33 character(len=256) :: message
34 character(len=64) :: location
35 character(len=32) :: timestamp
36 end type error_info_t
37
38 type(error_info_t) :: error_history(50)
39
40 contains
41
42 ! Log an error with context information
43 subroutine log_error(severity, category, code, message, location)
44 integer, intent(in) :: severity, category, code
45 character(len=*), intent(in) :: message
46 character(len=*), intent(in), optional :: location
47
48 character(len=32) :: severity_str, category_str
49 character(len=64) :: loc_str
50
51 ! Increment error count and store in history
52 error_count = error_count + 1
53 if (error_count <= max_error_count) then
54 error_history(error_count)%severity = severity
55 error_history(error_count)%category = category
56 error_history(error_count)%code = code
57 error_history(error_count)%message = message
58 if (present(location)) then
59 error_history(error_count)%location = location
60 else
61 error_history(error_count)%location = 'unknown'
62 end if
63 call get_timestamp(error_history(error_count)%timestamp)
64 end if
65
66 ! Only display if severity is high enough
67 if (severity < ERR_WARN .and. .not. debug_mode) return
68
69 ! Format severity and category
70 call format_severity(severity, severity_str)
71 call format_category(category, category_str)
72
73 if (present(location)) then
74 loc_str = location
75 else
76 loc_str = 'unknown'
77 end if
78
79 ! Print error message
80 if (severity >= ERR_ERROR) then
81 write(error_unit, '(a,a,a,a,a,i15,a,a,a,a,a)') &
82 '[', trim(severity_str), '] ', trim(category_str), ' (', code, ') in ', &
83 trim(loc_str), ': ', trim(message)
84 else if (verbose_errors .or. debug_mode) then
85 write(output_unit, '(a,a,a,a,a,i15,a,a,a,a,a)') &
86 '[', trim(severity_str), '] ', trim(category_str), ' (', code, ') in ', &
87 trim(loc_str), ': ', trim(message)
88 end if
89
90 ! Fatal errors should terminate
91 if (severity == ERR_FATAL) then
92 write(error_unit, '(a)') 'FATAL ERROR: Terminating shell'
93 stop 1
94 end if
95 end subroutine
96
97 ! Convenience functions for common error types
98 subroutine parser_error(code, message, location)
99 integer, intent(in) :: code
100 character(len=*), intent(in) :: message
101 character(len=*), intent(in), optional :: location
102 call log_error(ERR_ERROR, ERR_CAT_PARSER, code, message, location)
103 end subroutine
104
105 subroutine executor_error(code, message, location)
106 integer, intent(in) :: code
107 character(len=*), intent(in) :: message
108 character(len=*), intent(in), optional :: location
109 call log_error(ERR_ERROR, ERR_CAT_EXECUTOR, code, message, location)
110 end subroutine
111
112 subroutine system_error(code, message, location)
113 integer, intent(in) :: code
114 character(len=*), intent(in) :: message
115 character(len=*), intent(in), optional :: location
116 call log_error(ERR_ERROR, ERR_CAT_SYSTEM, code, message, location)
117 end subroutine
118
119 subroutine io_error(code, message, location)
120 integer, intent(in) :: code
121 character(len=*), intent(in) :: message
122 character(len=*), intent(in), optional :: location
123 call log_error(ERR_ERROR, ERR_CAT_IO, code, message, location)
124 end subroutine
125
126 subroutine memory_error(code, message, location)
127 integer, intent(in) :: code
128 character(len=*), intent(in) :: message
129 character(len=*), intent(in), optional :: location
130 call log_error(ERR_FATAL, ERR_CAT_MEMORY, code, message, location)
131 end subroutine
132
133 subroutine debug_log(message, location)
134 character(len=*), intent(in) :: message
135 character(len=*), intent(in), optional :: location
136 call log_error(ERR_DEBUG, 0, 0, message, location)
137 end subroutine
138
139 subroutine warning_log(message, location)
140 character(len=*), intent(in) :: message
141 character(len=*), intent(in), optional :: location
142 call log_error(ERR_WARN, 0, 0, message, location)
143 end subroutine
144
145 ! Validate system resource availability
146 function check_system_resources() result(is_ok)
147 logical :: is_ok
148 integer :: available_memory, available_fds
149
150 is_ok = .true.
151
152 ! Basic resource checks (simplified)
153 available_memory = 1000000 ! Placeholder
154 available_fds = 100 ! Placeholder
155
156 if (available_memory < 1000) then
157 call system_error(301, 'Low memory warning', 'check_system_resources')
158 is_ok = .false.
159 end if
160
161 if (available_fds < 10) then
162 call system_error(302, 'Low file descriptor count', 'check_system_resources')
163 is_ok = .false.
164 end if
165 end function
166
167 ! Validate command before execution
168 function validate_command(command) result(is_valid)
169 character(len=*), intent(in) :: command
170 logical :: is_valid
171
172 is_valid = .true.
173
174 ! Basic command validation
175 if (len_trim(command) == 0) then
176 call executor_error(201, 'Empty command', 'validate_command')
177 is_valid = .false.
178 return
179 end if
180
181 if (len_trim(command) > 4096) then
182 call executor_error(202, 'Command too long', 'validate_command')
183 is_valid = .false.
184 return
185 end if
186
187 ! Check for potentially dangerous commands
188 if (index(command, 'rm -rf /') > 0) then
189 call executor_error(203, 'Dangerous command detected', 'validate_command')
190 is_valid = .false.
191 return
192 end if
193
194 call debug_log('Command validation passed: ' // trim(command), 'validate_command')
195 end function
196
197 ! Validate file operations
198 function validate_file_operation(operation, filepath) result(is_valid)
199 character(len=*), intent(in) :: operation, filepath
200 logical :: is_valid
201
202 is_valid = .true.
203
204 if (len_trim(filepath) == 0) then
205 call io_error(401, 'Empty file path', 'validate_file_operation')
206 is_valid = .false.
207 return
208 end if
209
210 if (len_trim(filepath) > 4096) then
211 call io_error(402, 'File path too long', 'validate_file_operation')
212 is_valid = .false.
213 return
214 end if
215
216 ! Check for directory traversal attempts
217 if (index(filepath, '../') > 0) then
218 call warning_log('Directory traversal detected: ' // trim(filepath), 'validate_file_operation')
219 end if
220
221 call debug_log('File operation validated: ' // trim(operation) // ' ' // trim(filepath), &
222 'validate_file_operation')
223 end function
224
225 ! Memory allocation wrapper with error handling
226 subroutine safe_allocate_string_array(array, size, length, location)
227 character(len=:), allocatable, intent(out) :: array(:)
228 integer, intent(in) :: size, length
229 character(len=*), intent(in), optional :: location
230
231 integer :: stat
232 character(len=64) :: loc_str
233
234 if (present(location)) then
235 loc_str = location
236 else
237 loc_str = 'unknown'
238 end if
239
240 allocate(character(len=length) :: array(size), stat=stat)
241
242 if (stat /= 0) then
243 call memory_error(501, 'Failed to allocate string array', loc_str)
244 else
245 call debug_log('Successfully allocated string array', loc_str)
246 end if
247 end subroutine
248
249 ! Print error summary
250 subroutine print_error_summary()
251 integer :: i, warn_count, error_count_local, fatal_count
252
253 warn_count = 0
254 error_count_local = 0
255 fatal_count = 0
256
257 do i = 1, min(error_count, max_error_count)
258 select case(error_history(i)%severity)
259 case(ERR_WARN)
260 warn_count = warn_count + 1
261 case(ERR_ERROR)
262 error_count_local = error_count_local + 1
263 case(ERR_FATAL)
264 fatal_count = fatal_count + 1
265 end select
266 end do
267
268 if (error_count > 0) then
269 write(output_unit, '(a)') ''
270 write(output_unit, '(a)') 'Error Summary:'
271 write(output_unit, '(a,i15)') ' Warnings: ', warn_count
272 write(output_unit, '(a,i15)') ' Errors: ', error_count_local
273 write(output_unit, '(a,i15)') ' Fatal: ', fatal_count
274 write(output_unit, '(a,i15)') ' Total: ', min(error_count, max_error_count)
275 end if
276 end subroutine
277
278 ! Clear error history
279 subroutine clear_error_history()
280 error_count = 0
281 call debug_log('Error history cleared', 'clear_error_history')
282 end subroutine
283
284 ! Set debugging mode
285 subroutine set_debug_mode(enabled)
286 logical, intent(in) :: enabled
287 debug_mode = enabled
288 if (enabled) then
289 call debug_log('Debug mode enabled', 'set_debug_mode')
290 end if
291 end subroutine
292
293 ! Helper functions
294 subroutine format_severity(severity, str)
295 integer, intent(in) :: severity
296 character(len=*), intent(out) :: str
297
298 select case(severity)
299 case(ERR_DEBUG)
300 str = 'DEBUG'
301 case(ERR_INFO)
302 str = 'INFO'
303 case(ERR_WARN)
304 str = 'WARN'
305 case(ERR_ERROR)
306 str = 'ERROR'
307 case(ERR_FATAL)
308 str = 'FATAL'
309 case default
310 str = 'UNKNOWN'
311 end select
312 end subroutine
313
314 subroutine format_category(category, str)
315 integer, intent(in) :: category
316 character(len=*), intent(out) :: str
317
318 select case(category)
319 case(ERR_CAT_PARSER)
320 str = 'PARSER'
321 case(ERR_CAT_EXECUTOR)
322 str = 'EXECUTOR'
323 case(ERR_CAT_SYSTEM)
324 str = 'SYSTEM'
325 case(ERR_CAT_IO)
326 str = 'IO'
327 case(ERR_CAT_MEMORY)
328 str = 'MEMORY'
329 case default
330 str = 'GENERAL'
331 end select
332 end subroutine
333
334 subroutine get_timestamp(timestamp)
335 character(len=*), intent(out) :: timestamp
336 ! Simplified timestamp - in production would use system calls
337 timestamp = '2024-01-01T12:00:00'
338 end subroutine
339
340 end module error_handling