#!/usr/bin/perl
# -------------------------------------------------------
#   RICOH THETA Remote shutter
# -------------------------------------------------------
#  RICOH THETA HACKS! - MobileHackerz
#  http://mobilehackerz.jp/contents/Review/RICOH_THETA
#
# This program is free software. It comes without any warranty, to
# the extent permitted by applicable law. You can redistribute it
# and/or modify it under the terms of the Do What The Fuck You Want
# To Public License, Version 2, as published by Sam Hocevar. See
# http://www.wtfpl.net/txt/copying/ for more details.

use IO::Socket;
#use Encode;

# ----- TARGET THETA
my $Addr = "192.168.1.1";
my $Port = 15740;

# ----- My profile
my $Name = "THETA_Shutter";
my $GUID = "8a7ab04f-ebda-4f33-8649-8bf8c1cdc838";


my ($command_sock, $event_sock, $result, $session_id, $transaction_id, $payload, $data, $handle);

# Init_Command
$command_sock = &PTPIP_Open_Connection;
&PTPIP_Init_Command_Request($command_sock);
($result, $session_id) = &PTPIP_Wait_Init_Command_Ack($command_sock);
if ($result == 0) { die "No Init_Command_Ack"; }

# Init_Event
$event_sock = &PTPIP_Open_Connection;
&PTPIP_Init_Event_Request($event_sock,$session_id);
($result) = &PTPIP_Wait_Event_Request_Ack($event_sock);
if ($result == 0) { die "No Init_Event_Ack"; }
$transaction_id = 0;

# PTP_OC_OpenSession
&PTPIP_Cmd_Request($command_sock, $transaction_id++, "",  0x1002, $session_id );
($result,$payload,$data) = &PTPIP_Wait_Cmd_Response($command_sock);
if ($result == 0) { die "No Cmd_Response"; }

#&InitiateCapture(-2000);
&InitiateCapture(0);
#&InitiateCapture(2000);

&PTPIP_Close_Connection($event_sock);
&PTPIP_Close_Connection($command_sock);
exit;


# -------------------------------------------------------
#   Initiate Capture
# -------------------------------------------------------
# EV shift: 2000,1700,1300,1000,700,300,0,-300,-700,-1000,-1300,-1700,-2000

sub InitiateCapture {
    my $evshift = shift;
    my ($result, $payload, $data);
    my ($event , @params, $loop, $handle);

    # PTP_OC_SetDevicePropValue (EV shift)
    $payload = pack("v",($evshift));
    &PTPIP_Cmd_Request($command_sock, $transaction_id++, $payload, 0x1016, 0x5010);
    ($result,$payload,$data) = &PTPIP_Wait_Cmd_Response($command_sock);
    if ($result == 0) { die "No Cmd_Response"; }

    # PTP_OC_InitiateCapture
    &PTPIP_Cmd_Request($command_sock, $transaction_id++, "", 0x100E, 0, 0 );
    ($result,$payload,$data) = &PTPIP_Wait_Cmd_Response($command_sock);
    if ($result == 0) { die "No Cmd_Response"; }

    # Wait PTP_EC_CaptureComplete
    $handle = 0;
    for($loop=0;$loop<20;$loop++) {
        ($event,@params) = &PTPIP_Wait_Event($event_sock,0.5);
        if ($event == 0x400D) {
            # CaptureComplete
            last;
        } elsif ($event == 0x4002) {
            # Object Added
            $handle = $params[0];
        }
    }

    # PTP_OC_SetDevicePropValue (EV shift = 0)
    $payload = pack("v",0);
    &PTPIP_Cmd_Request($command_sock, $transaction_id++, $payload, 0x1016, 0x5010);
    ($result,$payload,$data) = &PTPIP_Wait_Cmd_Response($command_sock);
    if ($result == 0) { die "No Cmd_Response"; }
    $handle;
}


# -------------------------------------------------------
#   Init_Command
# -------------------------------------------------------

sub PTPIP_Init_Command_Request {
    my $sock = shift;

    my $payload = "";
    $payload .= pack("H8H4H4H4H12",split('-',$GUID));  # GUID
    $payload .= Encode_UTF16LE($Name."\x00");
    $payload .= pack("V",1);

    print $sock &PTPIP_pack_command( 1, $payload);
}

sub PTPIP_Wait_Init_Command_Ack {
    my $sock = shift;
    my ($result,$session_id,$target_guid,$target_name,$unknown1);
    my @error_response = (0,0);

    my ($cmd,$payload) = &PTPIP_Recv_Response($sock);
    if ($cmd != 2) { return @error_response; }

    $session_id  = unpack("V",$payload);
    $payload     = substr($payload,4);
    my (@guid)   = unpack("H8H4H4H4H12",$payload);
    $target_guid = join('-',@guid);
    $payload     = substr($payload,16);
    $target_name = Decode_UTF16LE(substr($payload,0,-4));
    $payload     = substr($payload,-4);
    $unknown1    = unpack("V",$payload);

    print "Target GUID :".$target_guid."\n";
    print "Target Name :".$target_name."\n";

    (1, $session_id);
}

# -------------------------------------------------------
#   Init_Event
# -------------------------------------------------------

sub PTPIP_Init_Event_Request {
    my $sock = shift;
    my $session_id = shift;

    my $payload = "";
    $payload .= pack("V",$session_id);

    print $sock &PTPIP_pack_command( 3, $payload);
}

sub PTPIP_Wait_Event_Request_Ack {
    my $sock = shift;
    my @error_response = (0);
    my ($cmd,$payload) = &PTPIP_Recv_Response($sock);
    if ($cmd != 4) { return @error_response; }

    1;
}

# -------------------------------------------------------
#   Wait_Event
# -------------------------------------------------------

sub PTPIP_Wait_Event {
    my $sock = shift;
    my $wait = shift;
    my ($rin,$event_id,$transaction_id,@params);
    my @error_response = (0);

    $rin = "";
    vec($rin, fileno($sock), 1)=1;
    if (select($rin,undef,undef,$wait)) {
        my ($cmd,$payload) = &PTPIP_Recv_Response($sock);
        if ($cmd != 8) { return @error_response; }

        $event_id       = unpack("v",$payload);
        $payload        = substr($payload,2);
        @params         = unpack("V*",$payload);
        $transaction_id = shift(@params);

        ($event_id, @params);
    } else {
        # no event
        @error_response;
    }
}


# -------------------------------------------------------
#   Cmd_Request
# -------------------------------------------------------

sub PTPIP_Cmd_Request {
    my $sock = shift;
    my $transaction_id = shift;
    my $send_payload = shift;
    my $cmd  = shift;
    my @args = @_;

    my $payload = "";
    $payload .= pack("V",1);
    $payload .= pack("v",$cmd);
    $payload .= pack("V",$transaction_id);
    $payload .= pack("V*",@args);

    print $sock &PTPIP_pack_command( 6, $payload);

    if ($send_payload ne "") {
        # Start Data Packet
        $payload = "";
        $payload .= pack("V",$transaction_id);
        $payload .= pack("V",length($send_payload));
        $payload .= pack("V",0);
        print $sock &PTPIP_pack_command( 9, $payload);
        #
        while(length($send_payload)>0) {
            my $buffer = substr($send_payload,0,200);
            $send_payload = substr($send_payload,200);
            $payload = "";
            $payload .= pack("V",$transaction_id);
            $payload .= $buffer;
            if ($send_payload ne "") {
                # Data Packet
                print $sock &PTPIP_pack_command(10, $payload);
            } else {
                # End Data Packet
                print $sock &PTPIP_pack_command(12, $payload);
            }
        }
    }
}

sub PTPIP_Wait_Cmd_Response {
    my $sock = shift;
    my @error_response = (0);
    my $transaction_id;
    my $data_payload = "";
    my $data_payload_size;

    my ($cmd,$payload) = &PTPIP_Recv_Response($sock);

    # with Data?
    if ($cmd == 9) {
        # Start Data Packet
        ($transaction_id,$data_payload_size) = unpack("VV",$payload);
        $payload        = substr($payload,8);
        $data_payload   = "";
        my $continue_flag  = 1;
        while($continue_flag) {
            ($cmd,$payload) = &PTPIP_Recv_Response($sock);
            if (($cmd != 10) && ($cmd != 12)) {
                # not Data_Packet and End_Data_Packet
                return @error_response;
            }

            my ($temp_transaction_id) = unpack("V",$payload);
            if ($transaction_id != $temp_transaction_id) { return @error_response; }
            $payload       = substr($payload,4);
            $data_payload .= $payload;
            if (length($data_payload)>=$data_payload_size) { $continue_flag = 0; }
            if ($cmd == 12) { $continue_flag = 0; } # End_Data_Packet
        }

        # Cmd Response
        ($cmd,$payload) = &PTPIP_Recv_Response($sock);
    }

    # Response?
    if ($cmd == 7) {
        # Cmd Response
        $transaction_id = unpack("V",$payload);
        $payload        = substr($payload,4);
        (1,$payload,$data_payload);
    } else {
        return @error_response;
    }
}

# -------------------------------------------------------
#   PTPIP utils
# -------------------------------------------------------

sub PTPIP_Open_Connection {
    my $sock = new IO::Socket::INET(PeerAddr=>$Addr,PeerPort=>$Port,Proto=>'tcp',TimeOut=>2);
    die "IO::Socket : $!" unless $sock;

    $sock;
}

sub PTPIP_Close_Connection {
    my $sock = shift;
    close($sock);
}

sub PTPIP_pack_command {
    my $cmd = shift;
    my $payload = shift;
#   print "snd:$cmd:".unpack("H*",$payload)."\n";
    pack("VV",(length($payload)+8),$cmd).$payload;
}

sub PTPIP_Recv_Response {
    my $sock = shift;
    my ($buf,$len,$command_type,$packet_len);
    my @error_response = (0,'');

    # packet length
    $len = read($sock,$buf,4);
    if ($len != 4) { return @error_response; }
    $packet_len = unpack("V",$buf);
    if ($packet_len > 1024) { return @error_response; }
    if ($packet_len < 8   ) { return @error_response; }

    # command
    $len = read($sock,$buf,4);
    if ($len != 4) { return @error_response; }
    $command_type = unpack("V",$buf);

    # payload
    $len = read($sock,$buf,$packet_len-8);
    if ($len != ($packet_len-8)) { return @error_response; }
#   print "rcv:".$command_type.":".unpack("H*",$buf)."\n";

    ($command_type,$buf);
}

sub Encode_UTF16LE {
    my $str = shift;
#   encode('UTF16LE', $str);
    pack("v*",unpack("c*",$str));
}

sub Decode_UTF16LE {
    my $str = shift;
#   decode('UTF16LE', $str)
    pack("c*",unpack("v*",$str));
}