Fusic Developers' Weblog

$ sudo apt-get install kvm libvirt

$ virsh
virsh にようこそ、仮想化対話式ターミナルです。
 
入力方法: 'help' コマンドに関するヘルプ
          'quit' 終了します
 
virsh # help
コマンド:
 
    help            ヘルプの表示
    attach-device   XML ファイルからデバイスを追加
    attach-disk     ディスク装置の接続
    attach-interface ネットワークインターフェースを接続します
    autostart       ドメインの自動起動
...
(以下略)
...
 
virsh #

$ sudo cpan install Tatsumaki
$ sudo cpan install Sys::Virt
...
(以下略)
...

use strict;
use warnings;
 
use Tatsumaki::Application;
use RunInstancesHandler;
use TerminateInstancesHandler;
use DescribeInstancesHandler;
 
 
package MainHandler;
use base qw(Tatsumaki::Handler);
 
sub get {
    my $self = shift;
    $self->write("Work well.\n");
}
 
package main;
use File::Basename;
 
my $app = Tatsumaki::Application->new([
        '/' => 'MainHandler',
        '/RunInstances' => 'RunInstancesHandler',
        '/TerminateInstances' => 'TerminateInstancesHandler',
        '/DescribeInstances' => 'DescribeInstancesHandler',
        ]);
return $app;

# run instance handler
package RunInstancesHandler;
 
use parent qw(Tatsumaki::Handler);
use strict;
use warnings;
 
use Sys::Virt;
use XML::Simple;
use Data::Dumper;
use String::Random;
use File::Basename;
use File::Copy;
use File::Spec;
 
sub post {
    my $self = shift;
 
    # create XML::Simple object
    my $xs = new XML::Simple(forcearray => 1, KeyAttr => [], RootName => '');
 
    # receive XML request
    my $xmlRequestRef = $xs->XMLin($self->request->content);
    my $xmlRef = $xs->XMLin($self->request->content);
 
    my $currentDir = dirname(__FILE__);
 
    # image id (default: lucid)
    my $imageId = 'lucid';
 
    # image file name
    my $baseImageFileName = $currentDir . '/images/' . $imageId . '.qcow2';
 
    # base xml file name
    my $baseImageXmlFileName = $currentDir . '/images/xml/' . $imageId . '.xml';
 
    # generate MAC address script path
    my $genMacAddrPath = $currentDir . '/tools/gen_mac_addr.sh';
 
    # instance memory size (default: 121072)
    my $memorySize = '131072';
 
    # Open & read base XML file
    open my $fh, '<', $baseImageXmlFileName or die "Could not open file: $!";
    sysread $fh, my $baseImageXml, -s $fh;
 
    # variables
    my $instanceName, my $uuid, my $macAddress, my $imageFileName, my $imageXmlRef;
 
    # get max instance count from request
    my $maxCount = $xmlRef->{maxCount}->[0];
 
    # connect QEMU
    my $vmm = Sys::Virt->new(address => "qemu:///system");
    my $domain;
 
    my $responseXmlTemplate = $currentDir . '/xml/run_instances_response.xml';
    my $responseItemXmlTemplate = $currentDir . '/xml/item.xml';
 
    # Open & read base XML file
    open $fh, '<', $responseXmlTemplate or die "Could not open file: $!";
    sysread $fh, my $responseXml, -s $fh;
 
    # Open & read item XML file
    open $fh, '<', $responseItemXmlTemplate or die "Could not open file: $!";
    sysread $fh, my $responseItemXml, -s $fh;
 
    my $responseXmlRef = $xs->XMLin($responseXml);
 
    my $itemXmlRef;
    my $domainXmlRef;
 
    # create images
    for (my $i = 0; $i < $maxCount; $i++) {
 
        # generate new instance name
        $instanceName = 'i-' . String::Random->new->randregex('[a-f0-9]{8}');
 
        # generate new UUID
        $uuid = `uuidgen`;
 
        # generate MAC address
        $macAddress = `$genMacAddrPath`;
        chomp($macAddress);
 
        # copy image file
        $imageFileName = File::Spec->rel2abs($currentDir . '/store/' . $instanceName . '.qcow2');
        copy($baseImageFileName, $imageFileName);
 
        # create XML Reference for booting
        $imageXmlRef = $xs->XMLin($baseImageXml);
 
        # change XML values
        $imageXmlRef->{domain}->[0]->{name}->[0] = $instanceName;
        $imageXmlRef->{domain}->[0]->{memory}->[0] = $memorySize;
        $imageXmlRef->{domain}->[0]->{currentMemory}->[0] = $memorySize;
        $imageXmlRef->{domain}->[0]->{uuid}->[0] = $uuid;
        $imageXmlRef->{domain}->[0]->{devices}->[0]->{disk}->[0]->{source}->[0]->{file} = $imageFileName;
        $imageXmlRef->{domain}->[0]->{devices}->[0]->{interface}->[0]->{mac}->[0]->{address} = $macAddress;
 
        $itemXmlRef = $xs->XMLin($responseItemXml);
        $itemXmlRef->{instanceId}->[0] = $instanceName;
        $itemXmlRef->{instanceState}->[0] = 'pending';
        $responseXmlRef->{RunInstancesResponse}->[0]->{item}->[0]->{instancesSet}->[0]->{item}->[$i] = $itemXmlRef;
        $domainXmlRef = '';
 
        # create domain
        $domain = $vmm->create_domain($xs->XMLout($imageXmlRef));
    }
    $self->response->headers([ 'Content-Type' => 'text/xml; charset=utf-8' ]);
    $self->write($xs->XMLout($responseXmlRef));
    $self->finish;
}
 
1;

$ plackup &
[1] 16392
Twiggy: Accepting connections at http://0.0.0.0:5000/

#!/usr/bin/perl -w
 
use strict;
 
use LWP::UserAgent;
use HTTP::Request::Common;
use File::Basename;
 
my $userAgent = LWP::UserAgent->new(agent => 'perl post');
 
my $requestXmlFile = dirname(__FILE__) . '/run_request.xml';
my $requestUrl = 'http://localhost:5000/RunInstances';
 
open my $fh, '<', $requestXmlFile or die "Could not open file: $!";
sysread $fh, my $message, -s $fh;
 
my $response = $userAgent->request(POST $requestUrl,
        Content_Type => 'text/xml',
        Content => $message);
 
print $response->error_as_HTML unless $response->is_success;
 
print $response->as_string;

<RunInstances xmlns="http://ec2.amazonaws.com/doc/2010-06-15/">
    <imageId>ami-60a54009</imageId>
    <minCount>1</minCount>
    <maxCount>3</maxCount>
    <keyName>example-key-name</keyName>
    <groupSet/>
    <placement>
        <availabilityZone>us-east-1b</availabilityZone>
    </placement>
    <kernelId>aki-ba3adfd3</kernelId>
    <ramdiskId>ari-badbad00</ramdiskId>
    <blockDeviceMapping>
        <item>
            <virtualName>ami</virtualName>
            <deviceName>sda1</deviceName>
        </item>
        <item>
            <virtualName>root</virtualName>
            <deviceName>/dev/sda1</deviceName>
        </item>
        <item>
            <virtualName>instancestore0</virtualName>
            <deviceName>sdb</deviceName>
        </item>
        <item>
            <virtualName>instance1</virtualName>
            <deviceName>sdc</deviceName>
        </item>
    </blockDeviceMapping>
    <userData version="1.0" encoding="base64">
        <data>"VGhpcyBpcyBiYXNlIDY0IQ==</data>
    </userData>
    <addressingType>public</addressingType>
    <monitoring>enabled</monitoring>
</RunInstances>

$ perl run_instances.pl
HTTP/1.0 200 OK
Content-Type: text/xml; charset=utf-8
Client-Date: Wed, 28 Jul 2010 02:56:47 GMT
Client-Peer: 127.0.0.1:5000
Client-Response-Num: 1
  <RunInstancesResponse xmlns="http://ec2.amazonaws.com/doc/2006-10-01">
    <groupSet>
      <item>
        <groupId>default</groupId>
      </item>
    </groupSet>
    <instancesSet></instancesSet>
    <item>
      <instancesSet>
        <item>
          <amiLaunchIndex>0</amiLaunchIndex>
          <dnsName></dnsName>
          <imageId>ami-60a54009</imageId>
          <instanceId>i-ea19a11c</instanceId>
          <instanceState>pending</instanceState>
          <keyName>example-key-name</keyName>
        </item>
        <item>
          <amiLaunchIndex>0</amiLaunchIndex>
          <dnsName></dnsName>
          <imageId>ami-60a54009</imageId>
          <instanceId>i-e89ae6b5</instanceId>
          <instanceState>pending</instanceState>
          <keyName>example-key-name</keyName>
        </item>
        <item>
          <amiLaunchIndex>0</amiLaunchIndex>
          <dnsName></dnsName>
          <imageId>ami-60a54009</imageId>
          <instanceId>i-fb30dc5a</instanceId>
          <instanceState>pending</instanceState>
          <keyName>example-key-name</keyName>
        </item>
      </instancesSet>
    </item>
    <ownerId>495219933132</ownerId>
    <reservationId>r-47a5402e</reservationId>
  </RunInstancesResponse>

$ virsh list
 Id 名前               状態
----------------------------------
 47 i-ea19a11c           実行中
 48 i-e89ae6b5           実行中
 49 i-fb30dc5a           実行中