On Mon, Nov 13, 2017 at 02:56:12PM +0100, Cédric Bosdonnat wrote:
+let checksums_get_sha512 = function + | None -> None + | Some csums -> + try + Some (List.find ( + function + | Checksums.SHA512 _ -> true + | _ -> false + ) csums) + with Not_found -> None
This is still a bit difficult to understand. How about this explicit loop? let checksums_get_sha512 = function | None -> None | Some csums -> let rec loop = function | [] -> None | Checksums.SHA512 csum :: _ -> Some csum | _ :: rest -> loop rest in loop csums
+let osinfo_ids = ref None + +let rec osinfo_get_short_ids () = + match !osinfo_ids with + | Some ids -> ids + | None -> + osinfo_ids := + Some ( + Osinfo.fold ( + fun set filepath -> + let doc = Xml.parse_file filepath in + let xpathctx = Xml.xpath_new_context doc in + let nodes = xpath_get_nodes xpathctx "/libosinfo/os/short-id" in + List.fold_left ( + fun set node -> + let id = Xml.node_as_string node in + StringSet.add id set + ) set nodes + ) StringSet.empty + ); + osinfo_get_short_ids ()
It doesn't really matter for this, but there is a nice way to write a generic "memoize" higher-order function: https://stackoverflow.com/questions/14454981/memoization-in-ocaml (You wouldn't need the recursive variant here)
+let compress_to file outdir = + let outimg = outdir // (Filename.basename file) ^ ".xz" in
Don't need parens around function application.
+ info "Compressing ...%!";
You don't need %! here because the ‘info’ function calls ‘print_newline’ from stdlib and ‘print_newline’ calls ‘flush stdout’: https://github.com/libguestfs/libguestfs/blob/a88385add653c4fc2592639d72b638... https://github.com/ocaml/ocaml/blob/c5fe6932b2151d0e4426072b4df3510318bc4edc...
+ let cmd = [ "xz"; "-f"; "--best"; "--block-size=16777216"; "-c"; file ] in + let file_flags = [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC; ] in + let outfd = Unix.openfile outimg file_flags 0o666 in + let res = run_command cmd ~stdout_chan:outfd in
I read the code of run_command but I don't think it closes outfd, and so outfd would be leaked here. Also it'd be nice to use with_openfile, if it was upstream. https://www.redhat.com/archives/libguestfs/2017-November/msg00028.html Pino ^ x 2 ?
+ if res <> 0 then + error (f_"‘xz’ command failed"); + outimg + +let get_mime_type filepath = + let file_cmd = "file --mime-type --brief " ^ (quote filepath) in
Don't need parens.
+let cmp a b = + let string_of_arch = function Index.Arch s -> s | Index.GuessedArch s -> s in + (string_of_arch a) = (string_of_arch b)
You don't need parens here. If you define Index.string_of_arch in the earlier then you can remove the definition of string_of_arch here as well.
+ +let has_entry id arch index = + List.exists ( + fun (item_id, { Index.arch = item_arch }) -> + item_id = id && (cmp item_arch arch)
Don't need parens.
+let process_image acc_entries filename repo tmprepo index interactive + compression sigchecker = + message (f_"Preparing %s") filename; + + let filepath = repo // filename in + let { format = format; size = size } = get_disk_image_info filepath in
Since commit c7651744da45 you can now write this as: let { format; size } = get_disk_image_info filepath in
+ let ask ?default ?values message = + let default_str = match default with + | None -> "" + | Some x -> sprintf " [%s] " x in + let list_str = match values with + | None -> "" + | Some x -> + sprintf (f_"Choose one from the list below:\n %s\n") + (String.concat "\n " x) in + + printf "%s%s%s%!" message default_str list_str;
Seems quite a long way of writing: let ask ?default ?values message = printf "%s" message; (match default with | None -> () | Some x -> printf " [%s] " x); (match values with | None -> () | Some x -> printf (f_"Choose ... etc ..)); let value = read_line () in ... I don't think you need to flush the channel because stdout is line buffered, and read_line will flush stdout anyway.
+ if not (Str.string_match (Str.regexp "[a-zA-Z0-9-_.]+") id 0) then (
It's not wrong to use Str, but you might want to use PCRE instead (see common/mlpcre) since Perl regexps are more familiar for most people. This could be written as: let re_valid_id = PCRE.compile ~anchored:true "[-a-zA-Z0-9_.]+" ... if not (PCRE.matches re_valid_id id) then ( etc. Note that Str regexps are anchored by default but PCRE regexps are not.
+ warning (f_"Allowed characters are letters, digits, - _ and ."); + ask_id default + ) else + id in + + let rec ask_arch guess = + let arches = [ "x86_64"; "aarch64"; "armv7l"; "i686"; "ppc64"; "ppc64le"; "s390x" ] in + match (ask (s_"Architecture: ") ~default:guess ~values:arches) with + | None -> ask_arch guess + | Some x -> + if x = "" then + ask_arch guess
It seems as if the ‘ask’ function returns ‘default’ if the user just hits return already.
+ let extract_entry_data ?entry () = + message (f_"Extracting data from the image..."); + let g = new Guestfs.guestfs () in
Use open_guestfs from Tools_utils instead of this line.
+ let printable_name = + match entry with + | Some (_, { Index.printable_name = printable_name }) ->
You can just write this with the same meaning: | Some (_, { Index.printable_name }) ->
+ (id, { Index.printable_name = printable_name; + osinfo = osinfo; + file_uri = Filename.basename out_path; [etc]
This can be written more concisely as: (id, { Index.printable_name; osinfo; file_uri = Filename.basename out_path; arch; signature_uri = None; checksums = Some [checksum]; revision; [etc]
+ let _, { Index.checksums = checksums } = file_entry in
This can be written as: let _, { Index.checksums } = file_entry in
+ let images = + let is_supported_format file = + let extension = last_part_of file '.' in + match extension with + | Some ext -> List.mem ext [ "qcow2"; "raw"; "img" ] + | None -> + match (get_mime_type file) with
You don't need parens here.
+ | None -> false + | Some mime -> mime = "application/octet-stream" in + let is_new file = + try + let _, { Index.checksums = checksums } =
You can now write this as: let _, { Index.checksums } =
+ List.find ( + fun (_, { Index.file_uri = file_uri }) ->
and: fun (_, { Index.file_uri }) ->
+ List.filter ( + fun file -> + if is_supported_format (cmdline.repo // file) then + is_new file + else + false
How about: List.filter ( fun file -> is_supported_format (cmdline.repo // file) && is_new file ) files
+ let index_channel = open_out outindex_path in
Be nice to use with_open_out here, if that patch was upstream. Pino ^ ?
+ (* Filter out entries for newly found images and entries + without a corresponding image file or with empty arch *) + let index = List.filter ( + fun (id, { Index.arch = arch; + Index.file_uri = file_uri }) ->
You can write: fun (id, { Index.arch; Index.file_uri }) ->
+ not (has_entry id arch images_entries) && Sys.file_exists file_uri + ) index in + + (* Convert all URIs back to relative ones *) + let index = List.map ( + fun (id, entry) -> + let { Index.file_uri = file_uri } = entry in
let { Index.file_uri } = entry in
+ (* Remove the index file since we have the signed version of it *) + if not cmdline.keep_unsigned then + Sys.remove (tmprepo // "index")
We normally keep the index files even if we have a signed version. Not sure which is better actually. Maybe we should delete them.
diff --git a/builder/test-virt-builder-repository.sh b/builder/test-virt-builder-repository.sh new file mode 100755 index 000000000..5ff270bcc --- /dev/null +++ b/builder/test-virt-builder-repository.sh @@ -0,0 +1,98 @@ +#!/bin/bash - +# libguestfs +# Copyright (C) 2017 SUSE Inc. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +set -e + +$TEST_FUNCTIONS +slow_test +skip_if_skipped "$script" + +test_data=repository-testdata +rm -rf $test_data +mkdir $test_data + +# Make a copy of the Fedora image +cp ../test-data/phony-guests/fedora.img $test_data + +# Create minimal index file +cat > $test_data/index << EOF +[fedora] +file=fedora.img +EOF + +# Run virt-builder-repository (no compression, interactive) +echo 'x86_64 +Fedora Test Image +fedora14 +/dev/sda1 +/dev/VG/Root +' | virt-builder-repository -v -x --no-compression -i $test_data + +assert_config () { + item=$1 + regex=$2 + + sed -n -e "/\[$item]/,/^$/p" $test_data/index | grep "$regex" +} + +# Check the generated index file +assert_config 'fedora' 'revision=1' +assert_config 'fedora' 'arch=x86_64' +assert_config 'fedora' 'name=Fedora Test Image' +assert_config 'fedora' 'osinfo=fedora14' +assert_config 'fedora' 'checksum' +assert_config 'fedora' 'format=raw' +assert_config 'fedora' '^size=' +assert_config 'fedora' 'compressed_size=' +assert_config 'fedora' 'expand=/dev/' + + +# Copy the debian image and add the minimal piece to index +cp ../test-data/phony-guests/debian.img $test_data + +cat >> $test_data/index << EOF + +[debian] +file=debian.img +EOF + +# Run virt-builder-repository again +echo 'x86_64 +Debian Test Image +debian9 + +' | virt-builder-repository --no-compression -i $test_data + +# Check that the new image is complete and the first one hasn't changed +assert_config 'fedora' 'revision=1' + +assert_config 'debian' 'revision=1' +assert_config 'debian' 'checksum' + +# Modify the fedora image +export EDITOR='echo newline >>' +virt-edit -a $test_data/fedora.img /etc/test3 + +# Rerun the tool (with compression) +virt-builder-repository -i $test_data + +# Check that the revision, file and size have been updated +assert_config 'fedora' 'revision=2' +assert_config 'fedora' 'file=fedora.img.xz' +test -e $test_data/fedora.img.xz +! test -e $test_data/fedora.img
The test should ‘rm’ any temporary files it created after a successful run (but not on error paths).
--- a/builder/utils.mli +++ b/builder/utils.mli @@ -32,3 +32,6 @@ val string_of_revision : revision -> string val get_image_infos : string -> Yajl.yajl_val (** [get_image_infos path] Run qemu-img info on the image pointed at path as YAJL tree. *) + +val increment_revision : revision -> revision +(** Add one to the version number *)
s/version/revision/ Looks good in general. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com Fedora Windows cross-compiler. Compile Windows programs, test, and build Windows installers. Over 100 libraries supported. http://fedoraproject.org/wiki/MinGW