+200 -156

lib/cfdp.ml

reviewed

··· 695 695 let p_large_file = Wire.Param.input "large_file" Wire.uint8 696 696 697 697 (* FSS size expression: 4 + 4 * large_file *) 698 698 - let fss_size = Wire.Expr.(Wire.int 4 + Wire.int 4 * Wire.Param.expr p_large_file) 698 698 + let fss_size = 699 699 + Wire.Expr.(Wire.int 4 + (Wire.int 4 * Wire.Param.expr p_large_file)) 699 700 700 701 (* {2 EOF Directive Codec} 701 702 ··· 722 723 let eof_codec = 723 724 Wire.Codec.v "CfdpEof" 724 725 (fun condition spare checksum file_size -> 725 725 - { pe_condition = condition; 726 726 + { 727 727 + pe_condition = condition; 726 728 pe_spare_eof = spare; 727 729 pe_checksum = checksum; 728 728 - pe_file_size = file_size }) 730 730 + pe_file_size = file_size; 731 731 + }) 729 732 Wire.Codec. 730 730 - [ (w_eof_condition $ fun e -> e.pe_condition); 733 733 + [ 734 734 + (w_eof_condition $ fun e -> e.pe_condition); 731 735 (w_eof_spare $ fun e -> e.pe_spare_eof); 732 736 (w_eof_checksum $ fun e -> e.pe_checksum); 733 733 - (w_eof_file_size $ fun e -> e.pe_file_size) ] 737 737 + (w_eof_file_size $ fun e -> e.pe_file_size); 738 738 + ] 734 739 735 740 (* {2 Finished Directive Codec} 736 741 ··· 754 759 let finished_codec = 755 760 Wire.Codec.v "CfdpFinished" 756 761 (fun condition delivery spare file_status -> 757 757 - { pfi_condition = condition; 762 762 + { 763 763 + pfi_condition = condition; 758 764 pfi_delivery = delivery; 759 765 pfi_spare = spare; 760 760 - pfi_file_status = file_status }) 766 766 + pfi_file_status = file_status; 767 767 + }) 761 768 Wire.Codec. 762 762 - [ (w_fin_condition $ fun f -> f.pfi_condition); 769 769 + [ 770 770 + (w_fin_condition $ fun f -> f.pfi_condition); 763 771 (w_fin_delivery $ fun f -> f.pfi_delivery); 764 772 (w_fin_spare $ fun f -> f.pfi_spare); 765 765 - (w_fin_file_status $ fun f -> f.pfi_file_status) ] 773 773 + (w_fin_file_status $ fun f -> f.pfi_file_status); 774 774 + ] 766 775 767 776 (* {2 ACK Directive Codec} 768 777 ··· 787 796 let ack_codec = 788 797 Wire.Codec.v "CfdpAck" 789 798 (fun directive subtype condition spare tx_status -> 790 790 - { pa_directive = directive; 799 799 + { 800 800 + pa_directive = directive; 791 801 pa_subtype = subtype; 792 802 pa_condition = condition; 793 803 pa_spare = spare; 794 794 - pa_tx_status = tx_status }) 804 804 + pa_tx_status = tx_status; 805 805 + }) 795 806 Wire.Codec. 796 796 - [ (w_ack_directive $ fun a -> a.pa_directive); 807 807 + [ 808 808 + (w_ack_directive $ fun a -> a.pa_directive); 797 809 (w_ack_subtype $ fun a -> a.pa_subtype); 798 810 (w_ack_condition $ fun a -> a.pa_condition); 799 811 (w_ack_spare $ fun a -> a.pa_spare); 800 800 - (w_ack_tx_status $ fun a -> a.pa_tx_status) ] 812 812 + (w_ack_tx_status $ fun a -> a.pa_tx_status); 813 813 + ] 801 814 802 815 (* {2 Metadata Directive Codec} 803 816 ··· 838 851 Wire.Codec.v "CfdpMetadata" 839 852 (fun closure reserved checksum_type file_size src_len src_name dst_len 840 853 dst_name -> 841 841 - { pm_closure = closure; 854 854 + { 855 855 + pm_closure = closure; 842 856 pm_reserved = reserved; 843 857 pm_checksum_type = checksum_type; 844 858 pm_file_size = file_size; 845 859 pm_src_len = src_len; 846 860 pm_src_name = src_name; 847 861 pm_dst_len = dst_len; 848 848 - pm_dst_name = dst_name }) 862 862 + pm_dst_name = dst_name; 863 863 + }) 849 864 Wire.Codec. 850 850 - [ (w_meta_closure $ fun m -> m.pm_closure); 865 865 + [ 866 866 + (w_meta_closure $ fun m -> m.pm_closure); 851 867 (w_meta_reserved $ fun m -> m.pm_reserved); 852 868 (w_meta_checksum_type $ fun m -> m.pm_checksum_type); 853 869 (w_meta_file_size $ fun m -> m.pm_file_size); 854 870 (w_meta_src_len $ fun m -> m.pm_src_len); 855 871 (w_meta_src_name $ fun m -> m.pm_src_name); 856 872 (w_meta_dst_len $ fun m -> m.pm_dst_len); 857 857 - (w_meta_dst_name $ fun m -> m.pm_dst_name) ] 873 873 + (w_meta_dst_name $ fun m -> m.pm_dst_name); 874 874 + ] 858 875 859 876 (* {2 NAK Directive} 860 877 ··· 882 899 Wire.Codec.v "CfdpPrompt" 883 900 (fun response spare -> { pp_response = response; pp_spare = spare }) 884 901 Wire.Codec. 885 885 - [ (w_prompt_response $ fun p -> p.pp_response); 886 886 - (w_prompt_spare $ fun p -> p.pp_spare) ] 902 902 + [ 903 903 + (w_prompt_response $ fun p -> p.pp_response); 904 904 + (w_prompt_spare $ fun p -> p.pp_spare); 905 905 + ] 887 906 888 907 (* {2 Keep Alive Directive Codec} 889 908 ··· 916 935 917 936 let encode_eof ~large_file (eof_pdu : eof) = 918 937 let fss_len = if large_file then 8 else 4 in 919 919 - let base_size = 1 + 4 + fss_len in (* condition/spare + checksum + fss *) 938 938 + let base_size = 1 + 4 + fss_len in 939 939 + (* condition/spare + checksum + fss *) 920 940 let fault_tlv = 921 941 match eof_pdu.fault_location with 922 942 | None -> "" ··· 930 950 Bytes.to_string tlv 931 951 in 932 952 let packed = 933 933 - { pe_condition = int_of_condition eof_pdu.condition; 953 953 + { 954 954 + pe_condition = int_of_condition eof_pdu.condition; 934 955 pe_spare_eof = 0; 935 956 pe_checksum = Int32.to_int eof_pdu.checksum; 936 936 - pe_file_size = int64_to_be_bytes fss_len eof_pdu.file_size } 957 957 + pe_file_size = int64_to_be_bytes fss_len eof_pdu.file_size; 958 958 + } 937 959 in 938 960 let payload = Bytes.create base_size in 939 961 Wire.Codec.encode eof_codec packed payload 0; ··· 942 964 943 965 let encode_finished (fin : finished) = 944 966 let packed = 945 945 - { pfi_condition = int_of_condition fin.condition; 967 967 + { 968 968 + pfi_condition = int_of_condition fin.condition; 946 969 pfi_delivery = 947 970 (match fin.delivery_code with 948 948 - | Data_complete -> 0 949 949 - | Data_incomplete -> 1); 971 971 + | Data_complete -> 0 972 972 + | Data_incomplete -> 1); 950 973 pfi_spare = 0; 951 974 pfi_file_status = 952 975 (match fin.file_status with 953 953 - | Discarded_deliberately -> 0 954 954 - | Discarded_filestore_rejection -> 1 955 955 - | Retained_successfully -> 2 956 956 - | Status_unreported -> 3) } 976 976 + | Discarded_deliberately -> 0 977 977 + | Discarded_filestore_rejection -> 1 978 978 + | Retained_successfully -> 2 979 979 + | Status_unreported -> 3); 980 980 + } 957 981 in 958 982 let payload = Bytes.create (Wire.Codec.wire_size finished_codec) in 959 983 Wire.Codec.encode finished_codec packed payload 0; ··· 962 986 963 987 let encode_ack (ack_pdu : ack) = 964 988 let packed = 965 965 - { pa_directive = int_of_directive_code ack_pdu.directive; 989 989 + { 990 990 + pa_directive = int_of_directive_code ack_pdu.directive; 966 991 pa_subtype = ack_pdu.subtype land 0xF; 967 992 pa_condition = int_of_condition ack_pdu.condition; 968 993 pa_spare = 0; 969 994 pa_tx_status = 970 995 (match ack_pdu.transaction_status with 971 971 - | Tx_undefined -> 0 972 972 - | Tx_active -> 1 973 973 - | Tx_terminated -> 2 974 974 - | Tx_unrecognized -> 3) } 996 996 + | Tx_undefined -> 0 997 997 + | Tx_active -> 1 998 998 + | Tx_terminated -> 2 999 999 + | Tx_unrecognized -> 3); 1000 1000 + } 975 1001 in 976 1002 let payload = Bytes.create (Wire.Codec.wire_size ack_codec) in 977 1003 Wire.Codec.encode ack_codec packed payload 0; ··· 984 1010 let dst_len = String.length meta.dest_filename in 985 1011 let total = 1 + fss_len + 1 + src_len + 1 + dst_len in 986 1012 let packed = 987 987 - { pm_closure = (if meta.closure_requested then 1 else 0); 1013 1013 + { 1014 1014 + pm_closure = (if meta.closure_requested then 1 else 0); 988 1015 pm_reserved = 0; 989 1016 pm_checksum_type = int_of_checksum_type meta.checksum_type; 990 1017 pm_file_size = int64_to_be_bytes fss_len meta.file_size; 991 1018 pm_src_len = src_len; 992 1019 pm_src_name = meta.source_filename; 993 1020 pm_dst_len = dst_len; 994 994 - pm_dst_name = meta.dest_filename } 1021 1021 + pm_dst_name = meta.dest_filename; 1022 1022 + } 995 1023 in 996 1024 let payload = Bytes.create total in 997 1025 Wire.Codec.encode metadata_codec packed payload 0; ··· 1014 1042 1015 1043 let encode_prompt pmt = 1016 1044 let packed = 1017 1017 - { pp_response = 1045 1045 + { 1046 1046 + pp_response = 1018 1047 (match pmt.response with Prompt_nak -> 0 | Prompt_keep_alive -> 1); 1019 1019 - pp_spare = 0 } 1048 1048 + pp_spare = 0; 1049 1049 + } 1020 1050 in 1021 1051 let payload = Bytes.create (Wire.Codec.wire_size prompt_codec) in 1022 1052 Wire.Codec.encode prompt_codec packed payload 0; ··· 1177 1207 let env = make_env_lf eof_codec ~large_file in 1178 1208 (* Decode from offset off+1 (skip directive code byte) *) 1179 1209 match 1180 1180 - Wire.Codec.decode_with eof_codec env 1181 1181 - (Bytes.unsafe_of_string buf) (off + 1) 1210 1210 + Wire.Codec.decode_with eof_codec env (Bytes.unsafe_of_string buf) (off + 1) 1182 1211 with 1183 1212 | Error e -> Error (wire_error_to_cfdp e) 1184 1184 - | Ok pe -> 1213 1213 + | Ok pe -> ( 1185 1214 let cond_code = pe.pe_condition in 1186 1186 - (match condition_of_int cond_code with 1187 1187 - | None -> Error (Invalid_condition_code cond_code) 1188 1188 - | Some cond -> 1189 1189 - let cksum = Int32.of_int pe.pe_checksum in 1190 1190 - let fsize = be_bytes_to_int64 pe.pe_file_size in 1191 1191 - let fss_end = off + 1 + 1 + 4 + fss_len in 1192 1192 - (* Parse fault location TLV if present *) 1193 1193 - let floc, consumed = 1194 1194 - if len > fss_end - off && fss_end < String.length buf 1195 1195 - && Char.code buf.[fss_end] = 0x06 1196 1196 - then begin 1197 1197 - let tlv_len = Char.code buf.[fss_end + 1] in 1198 1198 - if tlv_len = 8 then 1199 1199 - let raw = be_bytes_to_int64 1200 1200 - (String.sub buf (fss_end + 2) 8) in 1201 1201 - match Entity_id.of_int64_unsigned raw with 1202 1202 - | `Ok eid -> (Some eid, fss_end + 2 + tlv_len - off) 1203 1203 - | `Overflow -> (None, fss_end - off) 1204 1204 - else (None, fss_end - off) 1205 1205 - end 1206 1206 - else (None, fss_end - off) 1207 1207 - in 1208 1208 - Ok 1209 1209 - ( Eof 1210 1210 - { condition = cond; 1211 1211 - checksum = cksum; 1212 1212 - file_size = fsize; 1213 1213 - fault_location = floc }, 1214 1214 - consumed )) 1215 1215 + match condition_of_int cond_code with 1216 1216 + | None -> Error (Invalid_condition_code cond_code) 1217 1217 + | Some cond -> 1218 1218 + let cksum = Int32.of_int pe.pe_checksum in 1219 1219 + let fsize = be_bytes_to_int64 pe.pe_file_size in 1220 1220 + let fss_end = off + 1 + 1 + 4 + fss_len in 1221 1221 + (* Parse fault location TLV if present *) 1222 1222 + let floc, consumed = 1223 1223 + if 1224 1224 + len > fss_end - off 1225 1225 + && fss_end < String.length buf 1226 1226 + && Char.code buf.[fss_end] = 0x06 1227 1227 + then begin 1228 1228 + let tlv_len = Char.code buf.[fss_end + 1] in 1229 1229 + if tlv_len = 8 then 1230 1230 + let raw = 1231 1231 + be_bytes_to_int64 (String.sub buf (fss_end + 2) 8) 1232 1232 + in 1233 1233 + match Entity_id.of_int64_unsigned raw with 1234 1234 + | `Ok eid -> (Some eid, fss_end + 2 + tlv_len - off) 1235 1235 + | `Overflow -> (None, fss_end - off) 1236 1236 + else (None, fss_end - off) 1237 1237 + end 1238 1238 + else (None, fss_end - off) 1239 1239 + in 1240 1240 + Ok 1241 1241 + ( Eof 1242 1242 + { 1243 1243 + condition = cond; 1244 1244 + checksum = cksum; 1245 1245 + file_size = fsize; 1246 1246 + fault_location = floc; 1247 1247 + }, 1248 1248 + consumed )) 1215 1249 1216 1250 let decode_finished _buf off len = 1217 1251 if len < 2 then Error (Truncated { need = 2; have = len }) 1218 1252 else 1219 1253 match 1220 1220 - Wire.Codec.decode finished_codec 1221 1221 - (Bytes.unsafe_of_string _buf) (off + 1) 1254 1254 + Wire.Codec.decode finished_codec (Bytes.unsafe_of_string _buf) (off + 1) 1222 1255 with 1223 1256 | Error e -> Error (wire_error_to_cfdp e) 1224 1224 - | Ok pf -> 1257 1257 + | Ok pf -> ( 1225 1258 let cond_code = pf.pfi_condition in 1226 1226 - (match condition_of_int cond_code with 1227 1227 - | None -> Error (Invalid_condition_code cond_code) 1228 1228 - | Some cond -> 1229 1229 - let delivery = 1230 1230 - if pf.pfi_delivery = 0 then Data_complete else Data_incomplete 1231 1231 - in 1232 1232 - let status = 1233 1233 - match pf.pfi_file_status with 1234 1234 - | 0 -> Discarded_deliberately 1235 1235 - | 1 -> Discarded_filestore_rejection 1236 1236 - | 2 -> Retained_successfully 1237 1237 - | _ -> Status_unreported 1238 1238 - in 1239 1239 - Ok 1240 1240 - ( Finished 1241 1241 - { condition = cond; 1242 1242 - delivery_code = delivery; 1243 1243 - file_status = status; 1244 1244 - filestore_responses = []; 1245 1245 - fault_location = None }, 1246 1246 - 2 )) 1259 1259 + match condition_of_int cond_code with 1260 1260 + | None -> Error (Invalid_condition_code cond_code) 1261 1261 + | Some cond -> 1262 1262 + let delivery = 1263 1263 + if pf.pfi_delivery = 0 then Data_complete else Data_incomplete 1264 1264 + in 1265 1265 + let status = 1266 1266 + match pf.pfi_file_status with 1267 1267 + | 0 -> Discarded_deliberately 1268 1268 + | 1 -> Discarded_filestore_rejection 1269 1269 + | 2 -> Retained_successfully 1270 1270 + | _ -> Status_unreported 1271 1271 + in 1272 1272 + Ok 1273 1273 + ( Finished 1274 1274 + { 1275 1275 + condition = cond; 1276 1276 + delivery_code = delivery; 1277 1277 + file_status = status; 1278 1278 + filestore_responses = []; 1279 1279 + fault_location = None; 1280 1280 + }, 1281 1281 + 2 )) 1247 1282 1248 1283 let decode_ack _buf off len = 1249 1284 if len < 3 then Error (Truncated { need = 3; have = len }) ··· 1252 1287 Wire.Codec.decode ack_codec (Bytes.unsafe_of_string _buf) (off + 1) 1253 1288 with 1254 1289 | Error e -> Error (wire_error_to_cfdp e) 1255 1255 - | Ok pa -> 1290 1290 + | Ok pa -> ( 1256 1291 let dir_code = pa.pa_directive in 1257 1292 let cond_code = pa.pa_condition in 1258 1258 - (match (directive_code_of_int dir_code, condition_of_int cond_code) with 1259 1259 - | None, _ -> Error (Invalid_directive_code dir_code) 1260 1260 - | _, None -> Error (Invalid_condition_code cond_code) 1261 1261 - | Some dc, Some cond -> 1262 1262 - let status = 1263 1263 - match pa.pa_tx_status with 1264 1264 - | 0 -> Tx_undefined 1265 1265 - | 1 -> Tx_active 1266 1266 - | 2 -> Tx_terminated 1267 1267 - | _ -> Tx_unrecognized 1268 1268 - in 1269 1269 - Ok 1270 1270 - ( Ack 1271 1271 - { directive = dc; 1272 1272 - subtype = pa.pa_subtype; 1273 1273 - condition = cond; 1274 1274 - transaction_status = status }, 1275 1275 - 3 )) 1293 1293 + match (directive_code_of_int dir_code, condition_of_int cond_code) with 1294 1294 + | None, _ -> Error (Invalid_directive_code dir_code) 1295 1295 + | _, None -> Error (Invalid_condition_code cond_code) 1296 1296 + | Some dc, Some cond -> 1297 1297 + let status = 1298 1298 + match pa.pa_tx_status with 1299 1299 + | 0 -> Tx_undefined 1300 1300 + | 1 -> Tx_active 1301 1301 + | 2 -> Tx_terminated 1302 1302 + | _ -> Tx_unrecognized 1303 1303 + in 1304 1304 + Ok 1305 1305 + ( Ack 1306 1306 + { 1307 1307 + directive = dc; 1308 1308 + subtype = pa.pa_subtype; 1309 1309 + condition = cond; 1310 1310 + transaction_status = status; 1311 1311 + }, 1312 1312 + 3 )) 1276 1313 1277 1314 let decode_metadata ~large_file buf off len = 1278 1315 let fss_len = if large_file then 8 else 4 in ··· 1282 1319 let env = make_env_lf metadata_codec ~large_file in 1283 1320 match 1284 1321 Wire.Codec.decode_with metadata_codec env 1285 1285 - (Bytes.unsafe_of_string buf) (off + 1) 1322 1322 + (Bytes.unsafe_of_string buf) 1323 1323 + (off + 1) 1286 1324 with 1287 1325 | Error e -> Error (wire_error_to_cfdp e) 1288 1288 - | Ok pm -> 1326 1326 + | Ok pm -> ( 1289 1327 let cksum_type = pm.pm_checksum_type in 1290 1290 - (match checksum_type_of_int cksum_type with 1291 1291 - | None -> Error (Invalid_checksum_type cksum_type) 1292 1292 - | Some ctype -> 1293 1293 - let fsize = be_bytes_to_int64 pm.pm_file_size in 1294 1294 - let consumed = 1295 1295 - 1 + 1 + fss_len + 1 + pm.pm_src_len + 1 + pm.pm_dst_len 1296 1296 - in 1297 1297 - Ok 1298 1298 - ( Metadata 1299 1299 - { closure_requested = pm.pm_closure = 1; 1300 1300 - checksum_type = ctype; 1301 1301 - file_size = fsize; 1302 1302 - source_filename = pm.pm_src_name; 1303 1303 - dest_filename = pm.pm_dst_name; 1304 1304 - filestore_requests = []; 1305 1305 - messages_to_user = [] }, 1306 1306 - consumed )) 1328 1328 + match checksum_type_of_int cksum_type with 1329 1329 + | None -> Error (Invalid_checksum_type cksum_type) 1330 1330 + | Some ctype -> 1331 1331 + let fsize = be_bytes_to_int64 pm.pm_file_size in 1332 1332 + let consumed = 1333 1333 + 1 + 1 + fss_len + 1 + pm.pm_src_len + 1 + pm.pm_dst_len 1334 1334 + in 1335 1335 + Ok 1336 1336 + ( Metadata 1337 1337 + { 1338 1338 + closure_requested = pm.pm_closure = 1; 1339 1339 + checksum_type = ctype; 1340 1340 + file_size = fsize; 1341 1341 + source_filename = pm.pm_src_name; 1342 1342 + dest_filename = pm.pm_dst_name; 1343 1343 + filestore_requests = []; 1344 1344 + messages_to_user = []; 1345 1345 + }, 1346 1346 + consumed )) 1307 1347 1308 1348 let decode_nak ~large_file buf off len = 1309 1349 let fss_len = if large_file then 8 else 4 in 1310 1310 - let min_len = 1 + 2 * fss_len in 1350 1350 + let min_len = 1 + (2 * fss_len) in 1311 1351 if len < min_len then Error (Truncated { need = min_len; have = len }) 1312 1352 else 1313 1353 (* Decode scope fields from off+1 (skip directive code) using byte_array *) 1314 1354 let scope_buf = Bytes.unsafe_of_string buf in 1315 1315 - let sscope = be_bytes_to_int64 1316 1316 - (String.sub buf (off + 1) fss_len) in 1317 1317 - let escope = be_bytes_to_int64 1318 1318 - (String.sub buf (off + 1 + fss_len) fss_len) in 1319 1319 - let remaining = len - (1 + 2 * fss_len) in 1355 1355 + let sscope = be_bytes_to_int64 (String.sub buf (off + 1) fss_len) in 1356 1356 + let escope = 1357 1357 + be_bytes_to_int64 (String.sub buf (off + 1 + fss_len) fss_len) 1358 1358 + in 1359 1359 + let remaining = len - (1 + (2 * fss_len)) in 1320 1360 let seg_count = remaining / (2 * fss_len) in 1321 1361 let segs = ref [] in 1322 1322 - let curr_off = ref (off + 1 + 2 * fss_len) in 1362 1362 + let curr_off = ref (off + 1 + (2 * fss_len)) in 1323 1363 for _ = 1 to seg_count do 1324 1324 - let soff = be_bytes_to_int64 1325 1325 - (Bytes.sub_string scope_buf !curr_off fss_len) in 1326 1326 - let eoff = be_bytes_to_int64 1327 1327 - (Bytes.sub_string scope_buf (!curr_off + fss_len) fss_len) in 1364 1364 + let soff = 1365 1365 + be_bytes_to_int64 (Bytes.sub_string scope_buf !curr_off fss_len) 1366 1366 + in 1367 1367 + let eoff = 1368 1368 + be_bytes_to_int64 1369 1369 + (Bytes.sub_string scope_buf (!curr_off + fss_len) fss_len) 1370 1370 + in 1328 1371 segs := { start_offset = soff; end_offset = eoff } :: !segs; 1329 1329 - curr_off := !curr_off + 2 * fss_len 1372 1372 + curr_off := !curr_off + (2 * fss_len) 1330 1373 done; 1331 1374 Ok 1332 1375 ( Nak 1333 1333 - { start_scope = sscope; 1376 1376 + { 1377 1377 + start_scope = sscope; 1334 1378 end_scope = escope; 1335 1335 - segments = List.rev !segs }, 1379 1379 + segments = List.rev !segs; 1380 1380 + }, 1336 1381 !curr_off - off ) 1337 1382 1338 1383 let decode_prompt _buf off len = 1339 1384 if len < 2 then Error (Truncated { need = 2; have = len }) 1340 1385 else 1341 1386 match 1342 1342 - Wire.Codec.decode prompt_codec 1343 1343 - (Bytes.unsafe_of_string _buf) (off + 1) 1387 1387 + Wire.Codec.decode prompt_codec (Bytes.unsafe_of_string _buf) (off + 1) 1344 1388 with 1345 1389 | Error e -> Error (wire_error_to_cfdp e) 1346 1390 | Ok pp -> ··· 1351 1395 1352 1396 let decode_keep_alive ~large_file buf off len = 1353 1397 let fss_len = if large_file then 8 else 4 in 1354 1354 - if len < 1 + fss_len then 1355 1355 - Error (Truncated { need = 1 + fss_len; have = len }) 1398 1398 + if len < 1 + fss_len then Error (Truncated { need = 1 + fss_len; have = len }) 1356 1399 else 1357 1400 let env = make_env_lf keep_alive_codec ~large_file in 1358 1401 match 1359 1402 Wire.Codec.decode_with keep_alive_codec env 1360 1360 - (Bytes.unsafe_of_string buf) (off + 1) 1403 1403 + (Bytes.unsafe_of_string buf) 1404 1404 + (off + 1) 1361 1405 with 1362 1406 | Error e -> Error (wire_error_to_cfdp e) 1363 1407 | Ok pk -> ··· 1412 1456 else if off_after_meta + fss_len > buf_len then 1413 1457 truncated ~need:fss_len ~have:(buf_len - off_after_meta) 1414 1458 else 1415 1415 - let foff = 1416 1416 - be_bytes_to_int64 (String.sub buf off_after_meta fss_len) 1417 1417 - in 1459 1459 + let foff = be_bytes_to_int64 (String.sub buf off_after_meta fss_len) in 1418 1460 let data_start = off_after_meta + fss_len in 1419 1461 let data_len_actual = data_len - (data_start - off) in 1420 1462 if data_start + data_len_actual > buf_len then ··· 1424 1466 Bytes.of_string (String.sub buf data_start data_len_actual) 1425 1467 in 1426 1468 Ok 1427 1427 - ( { continuation = cont; 1469 1469 + ( { 1470 1470 + continuation = cont; 1428 1471 segment_metadata = seg_meta; 1429 1472 offset = foff; 1430 1430 - data = fdata }, 1473 1473 + data = fdata; 1474 1474 + }, 1431 1475 data_len ) 1432 1476 1433 1477 let decode buf =

+78

test/interop/dariol83/scripts/GenerateKeepAlive.java

reviewed

··· 1 1 + /** 2 2 + * Generate CFDP KeepAlive PDU interop traces using dariol83/ccsds. 3 3 + * 4 4 + * Reference: eu.dariolucia.ccsds.cfdp (Java, Apache 2.0) 5 5 + * Build: see generate.sh 6 6 + * Output: CSV with columns: name, source_entity, dest_entity, seq_nr, 7 7 + * entity_id_len, seq_nr_len, direction, mode, progress, 8 8 + * large_file, pdu_hex 9 9 + */ 10 10 + 11 11 + import eu.dariolucia.ccsds.cfdp.protocol.builder.KeepAlivePduBuilder; 12 12 + import eu.dariolucia.ccsds.cfdp.protocol.pdu.CfdpPdu; 13 13 + import eu.dariolucia.ccsds.cfdp.protocol.pdu.KeepAlivePdu; 14 14 + 15 15 + import java.io.*; 16 16 + 17 17 + public class GenerateKeepAlive { 18 18 + 19 19 + static String toHex(byte[] bytes) { 20 20 + StringBuilder sb = new StringBuilder(bytes.length * 2); 21 21 + for (byte b : bytes) sb.append(String.format("%02x", b & 0xFF)); 22 22 + return sb.toString(); 23 23 + } 24 24 + 25 25 + static void emit(PrintWriter w, String name, 26 26 + long src, long dst, long seq, 27 27 + int eidLen, int seqLen, 28 28 + long progress, boolean largeFile) { 29 29 + KeepAlivePduBuilder builder = new KeepAlivePduBuilder() 30 30 + .setDirection(CfdpPdu.Direction.TOWARD_FILE_SENDER) 31 31 + .setLargeFile(largeFile) 32 32 + .setSegmentMetadataPresent(false) 33 33 + .setSegmentationControlPreserved(false) 34 34 + .setAcknowledged(true) 35 35 + .setCrcPresent(false) 36 36 + .setEntityIdLength(eidLen) 37 37 + .setSourceEntityId(src) 38 38 + .setDestinationEntityId(dst) 39 39 + .setTransactionSequenceNumber(seq, seqLen) 40 40 + .setProgress(progress); 41 41 + 42 42 + KeepAlivePdu pdu = builder.build(); 43 43 + String hex = toHex(pdu.getPdu()); 44 44 + 45 45 + // direction: toward_sender (Java enum is TOWARD_FILE_SENDER) 46 46 + // mode: ack (acknowledged = true) 47 47 + w.printf("%s,%d,%d,%d,%d,%d,toward_sender,ack,%d,%s,%s%n", 48 48 + name, src, dst, seq, eidLen, seqLen, 49 49 + progress, largeFile ? "True" : "False", hex); 50 50 + } 51 51 + 52 52 + public static void main(String[] args) throws Exception { 53 53 + String outDir = args.length > 0 ? args[0] : "traces"; 54 54 + new File(outDir).mkdirs(); 55 55 + 56 56 + try (PrintWriter w = new PrintWriter( 57 57 + new FileWriter(new File(outDir, "keep_alive.csv")))) { 58 58 + w.println("name,source_entity,dest_entity,seq_nr," 59 59 + + "entity_id_len,seq_nr_len,direction,mode," 60 60 + + "progress,large_file,pdu_hex"); 61 61 + 62 62 + // progress=0 63 63 + emit(w, "ka_zero", 1, 2, 1, 1, 1, 0, false); 64 64 + // progress=256 (0x100) — the value that exposes LE bugs 65 65 + emit(w, "ka_256", 1, 2, 1, 1, 1, 256, false); 66 66 + // progress=1 MB 67 67 + emit(w, "ka_1mb", 1, 2, 1, 1, 1, 0x00100000, false); 68 68 + // progress=0xDEADBEEF 69 69 + emit(w, "ka_deadbeef", 1, 2, 1, 1, 1, 0xDEADBEEFL, false); 70 70 + // 2-byte entity IDs, 4-byte seq 71 71 + emit(w, "ka_2b_eid", 1, 2, 1, 2, 4, 65536, false); 72 72 + // large file (8-byte progress) 73 73 + emit(w, "ka_large_file", 1, 2, 1, 1, 1, 0x0001000200030004L, true); 74 74 + } 75 75 + 76 76 + System.out.println("Generated 6 KeepAlive traces (dariol83/ccsds)"); 77 77 + } 78 78 + }

+29

test/interop/dariol83/scripts/generate.sh

reviewed

··· 1 1 + #!/bin/sh 2 2 + # Generate CFDP KeepAlive interop traces from dariol83/ccsds (Java). 3 3 + # 4 4 + # Prerequisites: 5 5 + # - Java 11+ 6 6 + # - ~/git/dariol83-ccsds built: cd ~/git/dariol83-ccsds && mvn install -DskipTests -q 7 7 + # 8 8 + # Usage: ./generate.sh [output-dir] 9 9 + 10 10 + set -eu 11 11 + 12 12 + SCRIPT_DIR="$(cd "$(dirname "$0")" && pwd)" 13 13 + TRACE_DIR="${1:-"$SCRIPT_DIR/../traces"}" 14 14 + 15 15 + CFDP_JAR="$HOME/git/dariol83-ccsds/eu.dariolucia.ccsds.cfdp/target/eu.dariolucia.ccsds.cfdp-1.1.0-SNAPSHOT.jar" 16 16 + TMTC_JAR="$HOME/git/dariol83-ccsds/eu.dariolucia.ccsds.tmtc/target/eu.dariolucia.ccsds.tmtc-1.1.0-SNAPSHOT.jar" 17 17 + 18 18 + if [ ! -f "$CFDP_JAR" ]; then 19 19 + echo "ERROR: dariol83 CFDP JAR not found at $CFDP_JAR" >&2 20 20 + echo "Build it: cd ~/git/dariol83-ccsds && mvn install -DskipTests -q" >&2 21 21 + exit 1 22 22 + fi 23 23 + 24 24 + CP="$CFDP_JAR:$TMTC_JAR" 25 25 + mkdir -p "$TRACE_DIR" 26 26 + 27 27 + # Compile and run 28 28 + javac -cp "$CP" "$SCRIPT_DIR/GenerateKeepAlive.java" -d /tmp/dariol83-gen 29 29 + java -cp "/tmp/dariol83-gen:$CP" GenerateKeepAlive "$TRACE_DIR"

+146 -65

test/interop/spacepackets/test.ml

reviewed

··· 105 105 (name ^ " dest_entity") dest_entity 106 106 (Cfdp.Entity_id.to_int64 hdr.dest_entity); 107 107 Alcotest.(check int64) (name ^ " seq_nr") seq_nr hdr.transaction_seq; 108 108 - Alcotest.(check int) 109 109 - (name ^ " version") 1 hdr.version; 108 108 + Alcotest.(check int) (name ^ " version") 1 hdr.version; 110 109 let dir_eq = 111 110 match (direction, hdr.direction) with 112 111 | Cfdp.Toward_receiver, Cfdp.Toward_receiver ··· 145 144 Csvt.( 146 145 Row.( 147 146 obj 148 148 - (fun name _pdu_type source_entity dest_entity seq_nr entity_id_len 149 149 - seq_nr_len direction mode condition checksum file_size pdu_hex -> 147 147 + (fun 148 148 + name 149 149 + _pdu_type 150 150 + source_entity 151 151 + dest_entity 152 152 + seq_nr 153 153 + entity_id_len 154 154 + seq_nr_len 155 155 + direction 156 156 + mode 157 157 + condition 158 158 + checksum 159 159 + file_size 160 160 + pdu_hex 161 161 + -> 150 162 { 151 163 name; 152 164 source_entity; ··· 198 210 ~mode:(mode_of_string r.mode); 199 211 let expected_cond = condition_of_string r.condition in 200 212 let cond_eq = 201 201 - Cfdp.int_of_condition expected_cond = Cfdp.int_of_condition eof.condition 213 213 + Cfdp.int_of_condition expected_cond 214 214 + = Cfdp.int_of_condition eof.condition 202 215 in 203 216 Alcotest.(check bool) (r.name ^ " condition") true cond_eq; 204 204 - let expected_cksum = 205 205 - Int32.of_string ("0x" ^ r.checksum) 206 206 - in 217 217 + let expected_cksum = Int32.of_string ("0x" ^ r.checksum) in 207 218 Alcotest.(check int32) 208 219 (r.name ^ " checksum") expected_cksum eof.checksum; 209 220 Alcotest.(check int64) ··· 245 256 } 246 257 in 247 258 let eof_pdu = 248 248 - Cfdp.eof ~condition:(condition_of_string r.condition) 259 259 + Cfdp.eof 260 260 + ~condition:(condition_of_string r.condition) 249 261 ~checksum:(Int32.of_string ("0x" ^ r.checksum)) 250 262 ~file_size:(Int64.of_int r.file_size) () 251 263 in ··· 278 290 Csvt.( 279 291 Row.( 280 292 obj 281 281 - (fun name _pdu_type source_entity dest_entity seq_nr entity_id_len 282 282 - seq_nr_len direction mode closure_requested checksum_type file_size 283 283 - source_filename dest_filename pdu_hex -> 293 293 + (fun 294 294 + name 295 295 + _pdu_type 296 296 + source_entity 297 297 + dest_entity 298 298 + seq_nr 299 299 + entity_id_len 300 300 + seq_nr_len 301 301 + direction 302 302 + mode 303 303 + closure_requested 304 304 + checksum_type 305 305 + file_size 306 306 + source_filename 307 307 + dest_filename 308 308 + pdu_hex 309 309 + -> 284 310 { 285 311 name; 286 312 source_entity; ··· 344 370 Alcotest.(check int64) 345 371 (r.name ^ " file_size") (Int64.of_int r.file_size) md.file_size; 346 372 Alcotest.(check string) 347 347 - (r.name ^ " source_filename") r.source_filename md.source_filename; 373 373 + (r.name ^ " source_filename") 374 374 + r.source_filename md.source_filename; 348 375 Alcotest.(check string) 349 349 - (r.name ^ " dest_filename") r.dest_filename md.dest_filename 376 376 + (r.name ^ " dest_filename") 377 377 + r.dest_filename md.dest_filename 350 378 | Ok (Cfdp.Pdu_directive (_, _), _) -> 351 379 Alcotest.failf "%s: expected Metadata directive" r.name) 352 380 rows ··· 384 412 } 385 413 in 386 414 let md = 387 387 - Cfdp.metadata 388 388 - ~closure_requested:r.closure_requested 415 415 + Cfdp.metadata ~closure_requested:r.closure_requested 389 416 ~checksum_type:(checksum_type_of_string r.checksum_type) 390 417 ~file_size:(Int64.of_int r.file_size) 391 391 - ~source_filename:r.source_filename 392 392 - ~dest_filename:r.dest_filename () 418 418 + ~source_filename:r.source_filename ~dest_filename:r.dest_filename () 393 419 in 394 420 let pdu = Cfdp.Pdu_directive (hdr, Cfdp.Metadata md) in 395 421 let encoded = Cfdp.encode config pdu in ··· 418 444 Csvt.( 419 445 Row.( 420 446 obj 421 421 - (fun name _pdu_type source_entity dest_entity seq_nr entity_id_len 422 422 - seq_nr_len direction mode acked_directive acked_condition 423 423 - transaction_status pdu_hex -> 447 447 + (fun 448 448 + name 449 449 + _pdu_type 450 450 + source_entity 451 451 + dest_entity 452 452 + seq_nr 453 453 + entity_id_len 454 454 + seq_nr_len 455 455 + direction 456 456 + mode 457 457 + acked_directive 458 458 + acked_condition 459 459 + transaction_status 460 460 + pdu_hex 461 461 + -> 424 462 { 425 463 name; 426 464 source_entity; ··· 498 536 true 499 537 | _ -> false 500 538 in 501 501 - Alcotest.(check bool) 502 502 - (r.name ^ " transaction_status") true tx_eq 539 539 + Alcotest.(check bool) (r.name ^ " transaction_status") true tx_eq 503 540 | Ok (Cfdp.Pdu_directive (_, _), _) -> 504 541 Alcotest.failf "%s: expected ACK directive" r.name) 505 542 rows ··· 538 575 } 539 576 in 540 577 let ack_pdu = 541 541 - Cfdp.ack ~directive:dir ~subtype:(ack_subtype_of_directive dir) 578 578 + Cfdp.ack ~directive:dir 579 579 + ~subtype:(ack_subtype_of_directive dir) 542 580 ~condition:(condition_of_string r.acked_condition) 543 581 ~transaction_status:(tx_status_of_string r.transaction_status) 544 582 in ··· 569 607 Csvt.( 570 608 Row.( 571 609 obj 572 572 - (fun name _pdu_type source_entity dest_entity seq_nr entity_id_len 573 573 - seq_nr_len direction mode condition delivery_code file_status 574 574 - pdu_hex -> 610 610 + (fun 611 611 + name 612 612 + _pdu_type 613 613 + source_entity 614 614 + dest_entity 615 615 + seq_nr 616 616 + entity_id_len 617 617 + seq_nr_len 618 618 + direction 619 619 + mode 620 620 + condition 621 621 + delivery_code 622 622 + file_status 623 623 + pdu_hex 624 624 + -> 575 625 { 576 626 name; 577 627 source_entity; ··· 684 734 } 685 735 in 686 736 let fin = 687 687 - Cfdp.finished ~condition:(condition_of_string r.condition) 737 737 + Cfdp.finished 738 738 + ~condition:(condition_of_string r.condition) 688 739 ~delivery_code:(delivery_code_of_string r.delivery_code) 689 689 - ~file_status:(file_status_of_string r.file_status) () 740 740 + ~file_status:(file_status_of_string r.file_status) 741 741 + () 690 742 in 691 743 let pdu = Cfdp.Pdu_directive (hdr, Cfdp.Finished fin) in 692 744 let encoded = Cfdp.encode config pdu in ··· 714 766 Csvt.( 715 767 Row.( 716 768 obj 717 717 - (fun name _pdu_type source_entity dest_entity seq_nr entity_id_len 718 718 - seq_nr_len direction mode offset data_hex pdu_hex -> 769 769 + (fun 770 770 + name 771 771 + _pdu_type 772 772 + source_entity 773 773 + dest_entity 774 774 + seq_nr 775 775 + entity_id_len 776 776 + seq_nr_len 777 777 + direction 778 778 + mode 779 779 + offset 780 780 + data_hex 781 781 + pdu_hex 782 782 + -> 719 783 { 720 784 name; 721 785 source_entity; ··· 767 831 (r.name ^ " offset") (Int64.of_int r.offset) fd.offset; 768 832 let expected_data = hex_to_string r.data_hex in 769 833 Alcotest.(check string) 770 770 - (r.name ^ " data") expected_data 771 771 - (Bytes.to_string fd.data)) 834 834 + (r.name ^ " data") expected_data (Bytes.to_string fd.data)) 772 835 rows 773 836 774 837 let test_encode_file_data () = ··· 834 897 Csvt.( 835 898 Row.( 836 899 obj 837 837 - (fun name _pdu_type source_entity dest_entity seq_nr entity_id_len 838 838 - seq_nr_len direction mode start_scope end_scope segments pdu_hex -> 900 900 + (fun 901 901 + name 902 902 + _pdu_type 903 903 + source_entity 904 904 + dest_entity 905 905 + seq_nr 906 906 + entity_id_len 907 907 + seq_nr_len 908 908 + direction 909 909 + mode 910 910 + start_scope 911 911 + end_scope 912 912 + segments 913 913 + pdu_hex 914 914 + -> 839 915 { 840 916 name; 841 917 source_entity; ··· 870 946 else 871 947 String.split_on_char ';' s 872 948 |> List.map (fun seg -> 873 873 - match String.split_on_char '-' seg with 874 874 - | [ a; b ] -> 875 875 - Cfdp.segment_request (Int64.of_string a) (Int64.of_string b) 876 876 - | _ -> Alcotest.failf "bad segment format: %s" seg) 949 949 + match String.split_on_char '-' seg with 950 950 + | [ a; b ] -> 951 951 + Cfdp.segment_request (Int64.of_string a) (Int64.of_string b) 952 952 + | _ -> Alcotest.failf "bad segment format: %s" seg) 877 953 878 954 let test_decode_nak () = 879 955 let rows = ··· 897 973 ~mode:(mode_of_string r.mode); 898 974 Alcotest.(check int64) 899 975 (r.name ^ " start_scope") 900 900 - (Int64.of_int r.start_scope) nak.start_scope; 976 976 + (Int64.of_int r.start_scope) 977 977 + nak.start_scope; 901 978 Alcotest.(check int64) 902 902 - (r.name ^ " end_scope") 903 903 - (Int64.of_int r.end_scope) nak.end_scope; 979 979 + (r.name ^ " end_scope") (Int64.of_int r.end_scope) nak.end_scope; 904 980 let expected_segs = parse_segments r.segments in 905 981 Alcotest.(check int) 906 982 (r.name ^ " segment count") ··· 951 1027 in 952 1028 let segments = parse_segments r.segments in 953 1029 let nak_pdu = 954 954 - Cfdp.nak ~start_scope:(Int64.of_int r.start_scope) 1030 1030 + Cfdp.nak 1031 1031 + ~start_scope:(Int64.of_int r.start_scope) 955 1032 ~end_scope:(Int64.of_int r.end_scope) segments 956 1033 in 957 1034 let pdu = Cfdp.Pdu_directive (hdr, Cfdp.Nak nak_pdu) in ··· 989 1066 Csvt.( 990 1067 Row.( 991 1068 obj 992 992 - (fun name _pdu_type source_entity dest_entity seq_nr entity_id_len 993 993 - seq_nr_len direction mode progress large_file pdu_hex buggy_hex -> 1069 1069 + (fun 1070 1070 + name 1071 1071 + _pdu_type 1072 1072 + source_entity 1073 1073 + dest_entity 1074 1074 + seq_nr 1075 1075 + entity_id_len 1076 1076 + seq_nr_len 1077 1077 + direction 1078 1078 + mode 1079 1079 + progress 1080 1080 + large_file 1081 1081 + pdu_hex 1082 1082 + buggy_hex 1083 1083 + -> 994 1084 { 995 1085 name; 996 1086 source_entity; ··· 1030 1120 (fun (r : keep_alive_row) -> 1031 1121 let ref_str = hex_to_string r.pdu_hex in 1032 1122 match Cfdp.decode ref_str with 1033 1033 - | Error e -> 1034 1034 - Alcotest.failf "%s: decode failed: %a" r.name Cfdp.pp_error e 1123 1123 + | Error e -> Alcotest.failf "%s: decode failed: %a" r.name Cfdp.pp_error e 1035 1124 | Ok (Cfdp.Pdu_directive (hdr, Cfdp.Keep_alive ka), _) -> 1036 1125 check_header r.name hdr 1037 1126 ~source_entity:(Int64.of_int r.source_entity) ··· 1039 1128 ~seq_nr:(Int64.of_int r.seq_nr) 1040 1129 ~direction:(direction_of_string r.direction) 1041 1130 ~mode:(mode_of_string r.mode); 1042 1042 - Alcotest.(check int64) 1043 1043 - (r.name ^ " progress") r.progress ka.progress 1044 1044 - | Ok _ -> 1045 1045 - Alcotest.failf "%s: expected Keep_alive directive" r.name) 1131 1131 + Alcotest.(check int64) (r.name ^ " progress") r.progress ka.progress 1132 1132 + | Ok _ -> Alcotest.failf "%s: expected Keep_alive directive" r.name) 1046 1133 rows 1047 1134 1048 1135 let test_encode_keep_alive () = ··· 1081 1168 let pdu = Cfdp.Pdu_directive (hdr, Cfdp.Keep_alive ka) in 1082 1169 let encoded = Cfdp.encode config pdu in 1083 1170 let our_hex = string_to_hex encoded in 1084 1084 - Alcotest.(check string) 1085 1085 - (r.name ^ " exact bytes") r.pdu_hex our_hex) 1171 1171 + Alcotest.(check string) (r.name ^ " exact bytes") r.pdu_hex our_hex) 1086 1172 rows 1087 1173 1088 1174 let test_keep_alive_spacepackets_bug () = ··· 1096 1182 if r.progress <= 255L then 1097 1183 (* progress fits in one byte — byte order doesn't matter *) 1098 1184 Alcotest.(check string) 1099 1099 - (r.name ^ " same for small progress") r.pdu_hex r.buggy_hex 1185 1185 + (r.name ^ " same for small progress") 1186 1186 + r.pdu_hex r.buggy_hex 1100 1187 else 1101 1188 (* progress > 255 — buggy output must differ *) 1102 1189 Alcotest.(check bool) 1103 1103 - (r.name ^ " bytes differ (spacepackets LE bug)") true 1104 1104 - (r.pdu_hex <> r.buggy_hex)) 1190 1190 + (r.name ^ " bytes differ (spacepackets LE bug)") 1191 1191 + true (r.pdu_hex <> r.buggy_hex)) 1105 1192 rows 1106 1193 1107 1194 (* {1 Test Runner} *) ··· 1110 1197 Alcotest.run "cfdp-interop-spacepackets" 1111 1198 [ 1112 1199 ( "eof-decode", 1113 1113 - [ 1114 1114 - Alcotest.test_case "decode EOF reference" `Quick test_decode_eof; 1115 1115 - ] ); 1200 1200 + [ Alcotest.test_case "decode EOF reference" `Quick test_decode_eof ] ); 1116 1201 ( "eof-encode", 1117 1202 [ 1118 1203 Alcotest.test_case "encode EOF matches reference" `Quick ··· 1129 1214 test_encode_metadata; 1130 1215 ] ); 1131 1216 ( "ack-decode", 1132 1132 - [ 1133 1133 - Alcotest.test_case "decode ACK reference" `Quick test_decode_ack; 1134 1134 - ] ); 1217 1217 + [ Alcotest.test_case "decode ACK reference" `Quick test_decode_ack ] ); 1135 1218 ( "ack-encode", 1136 1219 [ 1137 1220 Alcotest.test_case "encode ACK matches reference" `Quick ··· 1158 1241 test_encode_file_data; 1159 1242 ] ); 1160 1243 ( "nak-decode", 1161 1161 - [ 1162 1162 - Alcotest.test_case "decode NAK reference" `Quick test_decode_nak; 1163 1163 - ] ); 1244 1244 + [ Alcotest.test_case "decode NAK reference" `Quick test_decode_nak ] ); 1164 1245 ( "nak-encode", 1165 1246 [ 1166 1247 Alcotest.test_case "encode NAK matches reference" `Quick