@@ -229,7 +229,7 @@ let get_hosts_by_name_or_id rpc session_id name =
229
229
230
230
let get_host_by_name_or_id rpc session_id name =
231
231
let hosts = get_hosts_by_name_or_id rpc session_id name in
232
- if List. length hosts = 0 then failwith (" Host " ^ name ^ " not found" ) ;
232
+ if hosts = [] then failwith (" Host " ^ name ^ " not found" ) ;
233
233
List. nth hosts 0
234
234
235
235
let get_host_from_session rpc session_id =
@@ -862,7 +862,7 @@ let make_param_funs getallrecs getbyuuid record class_name def_filters
862
862
]
863
863
in
864
864
let ops =
865
- if List. length settable > 0 then
865
+ if settable <> [] then
866
866
( cli_name " param-set"
867
867
, [" uuid" ]
868
868
, settable
@@ -877,7 +877,7 @@ let make_param_funs getallrecs getbyuuid record class_name def_filters
877
877
ops
878
878
in
879
879
let ops =
880
- if List. length addable > 0 then
880
+ if addable <> [] then
881
881
ops
882
882
@ [
883
883
( cli_name " param-add"
@@ -902,7 +902,7 @@ let make_param_funs getallrecs getbyuuid record class_name def_filters
902
902
ops
903
903
in
904
904
let ops =
905
- if List. length clearable > 0 then
905
+ if clearable <> [] then
906
906
ops
907
907
@ [
908
908
( cli_name " param-clear"
@@ -2928,13 +2928,7 @@ let event_wait_gen rpc session_id classname record_matches =
2928
2928
(List.map (fun r -> (r.name, fun () -> safe_get_field r)))
2929
2929
current_tbls
2930
2930
in
2931
- debug " Got % d records" (List.length all_recs) ;
2932
- (* true if anything matches now *)
2933
- let find_any_match recs =
2934
- let ls = List.map record_matches recs in
2935
- List.length (List.filter (fun x -> x) ls) > 0
2936
- in
2937
- find_any_match all_recs
2931
+ List.exists record_matches all_recs
2938
2932
in
2939
2933
finally
2940
2934
(fun () ->
@@ -3305,9 +3299,9 @@ let do_host_op rpc session_id op params ?(multiple = true) ignore_params =
3305
3299
failwith " No matching hosts found"
3306
3300
| 1 ->
3307
3301
[op 1 (List. hd hosts)]
3308
- | _ ->
3302
+ | len ->
3309
3303
if multiple && get_bool_param params " multiple" then
3310
- do_multiple (op ( List. length hosts) ) hosts
3304
+ do_multiple (op len ) hosts
3311
3305
else
3312
3306
failwith
3313
3307
( if not multiple then
@@ -3917,11 +3911,13 @@ let vm_install_real printer rpc session_id template name description params =
3917
3911
failwith
3918
3912
" SR specified via sr-uuid doesn't have the name specified via \
3919
3913
sr-name-label"
3920
- | None ->
3921
- if List. length sr_list > 1 then
3914
+ | None -> (
3915
+ match sr_list with
3916
+ | [x] ->
3917
+ Some x
3918
+ | _ ->
3922
3919
failwith " Multiple SRs with that name-label found"
3923
- else
3924
- Some (List. hd sr_list)
3920
+ )
3925
3921
)
3926
3922
else
3927
3923
sr_ref
@@ -4058,12 +4054,12 @@ let vm_install printer rpc session_id params =
4058
4054
List. fold_left filter_records_on_fields all_recs
4059
4055
((" name-label" , name) :: filter_params)
4060
4056
in
4061
- match List. length templates with
4062
- | 0 ->
4057
+ match templates with
4058
+ | [] ->
4063
4059
failwith " No templates matched"
4064
- | 1 ->
4065
- ( List. hd templates) .getref ()
4066
- | _ ->
4060
+ | [x] ->
4061
+ x .getref ()
4062
+ | _ :: _ :: _ ->
4067
4063
failwith " More than one matching template found"
4068
4064
in
4069
4065
if
@@ -4114,7 +4110,7 @@ let console fd _printer rpc session_id params =
4114
4110
| [] ->
4115
4111
marshal fd (Command (PrintStderr " No VM found\n " )) ;
4116
4112
raise (ExitWithError 1 )
4117
- | _ :: _ ->
4113
+ | _ :: _ :: _ ->
4118
4114
marshal fd
4119
4115
(Command
4120
4116
(PrintStderr
@@ -4153,9 +4149,10 @@ let vm_uninstall_common fd _printer rpc session_id params vms =
4153
4149
(* add extra text if the VDI is being shared *)
4154
4150
let r = Client.VDI. get_record ~rpc ~session_id ~self: vdi in
4155
4151
Printf. sprintf " VDI: %s (%s) %s" r.API. vDI_uuid r.API. vDI_name_label
4156
- ( if List. length r.API. vDI_VBDs < = 1 then
4152
+ ( match r.API. vDI_VBDs with
4153
+ | [] | [_] ->
4157
4154
" "
4158
- else
4155
+ | _ :: _ :: _ ->
4159
4156
" ** WARNING: disk is shared by other VMs"
4160
4157
)
4161
4158
in
@@ -4477,18 +4474,15 @@ let vm_retrieve_wlb_recommendations printer rpc session_id params =
4477
4474
in
4478
4475
try
4479
4476
let vms = select_vms rpc session_id params [] in
4480
- match List. length vms with
4481
- | 0 ->
4477
+ match vms with
4478
+ | [] ->
4482
4479
failwith " No matching VMs found"
4483
- | 1 ->
4480
+ | [x] ->
4484
4481
printer
4485
4482
(Cli_printer. PTable
4486
- [
4487
- (" Host(Uuid)" , " Stars, RecID, ZeroScoreReason" )
4488
- :: table (List. hd vms)
4489
- ]
4483
+ [(" Host(Uuid)" , " Stars, RecID, ZeroScoreReason" ) :: table x]
4490
4484
)
4491
- | _ ->
4485
+ | _ :: _ :: _ ->
4492
4486
failwith
4493
4487
" Multiple VMs found. Operation can only be performed on one VM at a \
4494
4488
time"
@@ -4628,7 +4622,7 @@ let vm_migrate printer rpc session_id params =
4628
4622
)
4629
4623
pifs
4630
4624
in
4631
- if List. length management_pifs = 0 then
4625
+ if management_pifs = [] then
4632
4626
failwith
4633
4627
(Printf. sprintf " Could not find management PIF on host %s"
4634
4628
host_record.API. host_uuid
@@ -5026,7 +5020,7 @@ let vm_disk_remove printer rpc session_id params =
5026
5020
(fun x -> device = Client.VBD. get_userdevice ~rpc ~session_id ~self: x)
5027
5021
vm_record.API. vM_VBDs
5028
5022
in
5029
- if List. length vbd_to_remove < 1 then
5023
+ if vbd_to_remove = [] then
5030
5024
failwith " Disk not found"
5031
5025
else
5032
5026
let vbd = List. nth vbd_to_remove 0 in
@@ -5052,7 +5046,7 @@ let vm_cd_remove printer rpc session_id params =
5052
5046
)
5053
5047
vm_record.API. vM_VBDs
5054
5048
in
5055
- if List. length vbd_to_remove < 1 then
5049
+ if vbd_to_remove = [] then
5056
5050
raise (failwith " Disk not found" )
5057
5051
else
5058
5052
let vbd = List. nth vbd_to_remove 0 in
@@ -5071,7 +5065,7 @@ let vm_cd_add printer rpc session_id params =
5071
5065
)
5072
5066
vdis
5073
5067
in
5074
- if List. length vdis = 0 then failwith (" CD " ^ cd_name ^ " not found!" ) ;
5068
+ if vdis = [] then failwith (" CD " ^ cd_name ^ " not found!" ) ;
5075
5069
let vdi = List. nth vdis 0 in
5076
5070
let op vm =
5077
5071
create_vbd_and_plug rpc session_id (vm.getref () ) vdi
@@ -5094,9 +5088,14 @@ let vm_cd_eject printer rpc session_id params =
5094
5088
(fun vbd -> Client.VBD. get_type ~rpc ~session_id ~self: vbd = `CD )
5095
5089
vbds
5096
5090
in
5097
- if List. length cdvbds = 0 then failwith " No CDs found" ;
5098
- if List. length cdvbds > 1 then
5099
- failwith " Two or more CDs found. Please use vbd-eject" ;
5091
+ ( match cdvbds with
5092
+ | [] ->
5093
+ failwith " No CDs found"
5094
+ | [_] ->
5095
+ ()
5096
+ | _ :: _ :: _ ->
5097
+ failwith " Two or more CDs found. Please use vbd-eject"
5098
+ ) ;
5100
5099
let cd = List. hd cdvbds in
5101
5100
Client.VBD. eject ~rpc ~session_id ~vbd: cd
5102
5101
in
@@ -5113,13 +5112,18 @@ let vm_cd_insert printer rpc session_id params =
5113
5112
)
5114
5113
vdis
5115
5114
in
5116
- if List. length vdis = 0 then failwith (" CD " ^ cd_name ^ " not found" ) ;
5117
- if List. length vdis > 1 then
5118
- failwith
5119
- (" Multiple CDs named "
5120
- ^ cd_name
5121
- ^ " found. Please use vbd-insert and specify uuids"
5122
- ) ;
5115
+ ( match vdis with
5116
+ | [] ->
5117
+ failwith (" CD " ^ cd_name ^ " not found" )
5118
+ | [_] ->
5119
+ ()
5120
+ | _ :: _ :: _ ->
5121
+ failwith
5122
+ (" Multiple CDs named "
5123
+ ^ cd_name
5124
+ ^ " found. Please use vbd-insert and specify uuids"
5125
+ )
5126
+ ) ;
5123
5127
let op vm =
5124
5128
let vm_record = vm.record () in
5125
5129
let vbds = vm_record.API. vM_VBDs in
@@ -5131,15 +5135,16 @@ let vm_cd_insert printer rpc session_id params =
5131
5135
)
5132
5136
vbds
5133
5137
in
5134
- if List. length cdvbds = 0 then
5135
- raise
5136
- (Api_errors. Server_error
5137
- (Api_errors. vm_no_empty_cd_vbd, [Ref. string_of (vm.getref () )])
5138
- ) ;
5139
- if List. length cdvbds > 1 then
5140
- failwith " Two or more empty CD devices found. Please use vbd-insert" ;
5141
- let cd = List. hd cdvbds in
5142
- Client.VBD. insert ~rpc ~session_id ~vbd: cd ~vdi: (List. hd vdis)
5138
+ match cdvbds with
5139
+ | [] ->
5140
+ raise
5141
+ (Api_errors. Server_error
5142
+ (Api_errors. vm_no_empty_cd_vbd, [Ref. string_of (vm.getref () )])
5143
+ )
5144
+ | [cd] ->
5145
+ Client.VBD. insert ~rpc ~session_id ~vbd: cd ~vdi: (List. hd vdis)
5146
+ | _ :: _ :: _ ->
5147
+ failwith " Two or more empty CD devices found. Please use vbd-insert"
5143
5148
in
5144
5149
ignore (do_vm_op printer rpc session_id op params [" cd-name" ])
5145
5150
@@ -5555,7 +5560,7 @@ let pool_retrieve_wlb_report fd _printer rpc session_id params =
5555
5560
in
5556
5561
download_file_with_task fd rpc session_id filename Constants. wlb_report_uri
5557
5562
(Printf. sprintf " report=%s%s%s" (Http. urlencode report)
5558
- (if List. length other_params = 0 then " " else " &" )
5563
+ (if other_params = [] then " " else " &" )
5559
5564
(String. concat " &"
5560
5565
(List. map
5561
5566
(fun (k , v ) ->
@@ -5978,7 +5983,7 @@ let vm_is_bios_customized printer rpc session_id params =
5978
5983
let bios_strings =
5979
5984
Client.VM. get_bios_strings ~rpc ~session_id ~self: (vm.getref () )
5980
5985
in
5981
- if List. length bios_strings = 0 then
5986
+ if bios_strings = [] then
5982
5987
printer
5983
5988
(Cli_printer. PMsg " The BIOS strings of this VM have not yet been set." )
5984
5989
else if bios_strings = Constants. generic_bios_strings then
@@ -7259,7 +7264,7 @@ let subject_role_common rpc session_id params =
7259
7264
let roles =
7260
7265
Client.Role. get_by_name_label ~rpc ~session_id ~label: role_name
7261
7266
in
7262
- if List. length roles > 0 then
7267
+ if roles <> [] then
7263
7268
List. hd roles (* names are unique, there's either 0 or 1*)
7264
7269
else
7265
7270
Ref. null
0 commit comments