<commit_before>(*
 * Copyright (C) 2006-2009 Citrix Systems Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published
 * by the Free Software Foundation; version 2.1 only. with the special
 * exception on linking described in file LICENSE.
 *
 * 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 Lesser General Public License for more details.
 *)
(** Common definitions and functions shared between the import and export code.
 * @group Import and Export
 *)

(** Represents a database record (the reference gets converted to a small string) *)
type obj = { cls: string; id: string; snapshot: XMLRPC.xmlrpc }

(** Version information attached to each export and checked on import *)
type version = 
    { hostname: string;
      date: string;
      product_version: string;
      product_brand: string;
      build_number: string;
      xapi_vsn_major: int;
      xapi_vsn_minor: int;
      export_vsn: int; (* 0 if missing, indicates eg whether to expect sha1sums in the stream *)
    }

(** An exported VM has a header record: *)
type header = 
    { version: version;
      objects: obj list }

exception Version_mismatch of string

module D=Debug.Debugger(struct let name="importexport" end)
open D

let find kvpairs where x = 
    if not(List.mem_assoc x kvpairs) 
    then raise (Failure (Printf.sprintf "Failed to find key '%s' in %s" x where))
    else List.assoc x kvpairs 

let string_of_obj x = x.cls ^ "  " ^ x.id

let _class = "class"
let _id = "id"
let _snapshot = "snapshot"

let xmlrpc_of_obj x = XMLRPC.To.structure
  [ _class,    XMLRPC.To.string x.cls;
    _id,       XMLRPC.To.string x.id;
    _snapshot, x.snapshot ]

let obj_of_xmlrpc x = 
  let kvpairs = XMLRPC.From.structure x in
  let find = find kvpairs "object data" in
  { cls      = XMLRPC.From.string (find _class);
    id       = XMLRPC.From.string (find _id);
    snapshot = find _snapshot }

(** Return a version struct corresponding to this host *)
let this_version __context = 
  let host = Helpers.get_localhost ~__context in
  let (_: API.host_t) = Db.Host.get_record ~__context ~self:host in  
  { hostname = Version.hostname;
    date = Version.date;
    product_version = Version.product_version;
    product_brand = Version.product_brand;
    build_number = Version.build_number;
    xapi_vsn_major = Xapi_globs.version_major;
    xapi_vsn_minor = Xapi_globs.version_minor;
    export_vsn = Xapi_globs.export_vsn;
  }

(** Raises an exception if a prospective import cannot be handled by this code.
    This will get complicated over time... *)
let assert_compatable ~__context other_version = 
  let this_version = this_version __context in
  let error() = 
    error "Import version is incompitable";
    raise (Api_errors.Server_error(Api_errors.import_incompatible_version, [])) in
  (* error if major versions differ; also error if this host has a
     lower minor vsn than the import *)
  if this_version.xapi_vsn_major<>other_version.xapi_vsn_major || this_version.xapi_vsn_minor<other_version.xapi_vsn_minor then
    error()

open Xapi_globs
let xmlrpc_of_version x =
  XMLRPC.To.structure
    [ _hostname,        XMLRPC.To.string x.hostname;
      _date,            XMLRPC.To.string x.date;
      _product_version, XMLRPC.To.string x.product_version;
      _product_brand,   XMLRPC.To.string x.product_brand;<commit_msg>CA-50172: Correct the spelling of a VM.import error message<commit_after>(*
 * Copyright (C) 2006-2009 Citrix Systems Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published
 * by the Free Software Foundation; version 2.1 only. with the special
 * exception on linking described in file LICENSE.
 *
 * 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 Lesser General Public License for more details.
 *)
(** Common definitions and functions shared between the import and export code.
 * @group Import and Export
 *)

(** Represents a database record (the reference gets converted to a small string) *)
type obj = { cls: string; id: string; snapshot: XMLRPC.xmlrpc }

(** Version information attached to each export and checked on import *)
type version = 
    { hostname: string;
      date: string;
      product_version: string;
      product_brand: string;
      build_number: string;
      xapi_vsn_major: int;
      xapi_vsn_minor: int;
      export_vsn: int; (* 0 if missing, indicates eg whether to expect sha1sums in the stream *)
    }

(** An exported VM has a header record: *)
type header = 
    { version: version;
      objects: obj list }

exception Version_mismatch of string

module D=Debug.Debugger(struct let name="importexport" end)
open D

let find kvpairs where x = 
    if not(List.mem_assoc x kvpairs) 
    then raise (Failure (Printf.sprintf "Failed to find key '%s' in %s" x where))
    else List.assoc x kvpairs 

let string_of_obj x = x.cls ^ "  " ^ x.id

let _class = "class"
let _id = "id"
let _snapshot = "snapshot"

let xmlrpc_of_obj x = XMLRPC.To.structure
  [ _class,    XMLRPC.To.string x.cls;
    _id,       XMLRPC.To.string x.id;
    _snapshot, x.snapshot ]

let obj_of_xmlrpc x = 
  let kvpairs = XMLRPC.From.structure x in
  let find = find kvpairs "object data" in
  { cls      = XMLRPC.From.string (find _class);
    id       = XMLRPC.From.string (find _id);
    snapshot = find _snapshot }

(** Return a version struct corresponding to this host *)
let this_version __context = 
  let host = Helpers.get_localhost ~__context in
  let (_: API.host_t) = Db.Host.get_record ~__context ~self:host in  
  { hostname = Version.hostname;
    date = Version.date;
    product_version = Version.product_version;
    product_brand = Version.product_brand;
    build_number = Version.build_number;
    xapi_vsn_major = Xapi_globs.version_major;
    xapi_vsn_minor = Xapi_globs.version_minor;
    export_vsn = Xapi_globs.export_vsn;
  }

(** Raises an exception if a prospective import cannot be handled by this code.
    This will get complicated over time... *)
let assert_compatable ~__context other_version = 
  let this_version = this_version __context in
  let error() = 
    error "Import version is incompatible";
    raise (Api_errors.Server_error(Api_errors.import_incompatible_version, [])) in
  (* error if major versions differ; also error if this host has a
     lower minor vsn than the import *)
  if this_version.xapi_vsn_major<>other_version.xapi_vsn_major || this_version.xapi_vsn_minor<other_version.xapi_vsn_minor then
    error()

open Xapi_globs
let xmlrpc_of_version x =
  XMLRPC.To.structure
    [ _hostname,        XMLRPC.To.string x.hostname;
      _date,            XMLRPC.To.string x.date;
      _product_version, XMLRPC.To.string x.product_version;
      _product_brand,   XMLRPC.To.string x.product_brand;
{'fraction_non_alphanumeric': 0.08025034770514604, 'fraction_numerical': 0.004033379694019471, 'mean_word_length': 3.5028177833437697, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 8}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7289575', 'n_tokens_mistral': 2237, 'n_tokens_neox': 2188, 'n_words': 775}