#!/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));
}