Ton

1
#!/usr/bin/fift -s
2
"TonUtil.fif" include
3
"GetOpt.fif" include
4

5
{ show-options-help 1 halt } : usage
6

7
60 =: timeout   // external message expires in 60 seconds
8
"dns-query.boc" =: savefile
9

10
begin-options
11
     " <filename-base> <contract-id> [-t<timeout>] [-o<savefile-boc>] <op> [<op2>...]" +cr +tab
12
    +"Creates a request to managed DNS smart contract created by new-manual-dns.fif, with private key loaded from file <filename-base>.pk "
13
    +"and address from <filename-base>-dns<contract-id>.addr, and saves it into <savefile-boc> ('" savefile $+ +"' by default)"
14
    +cr +"<op> is an operation description, one of" +cr +tab
15
    +"add <subdomain> cat <cat-id> (smc <smc-addr> | next <next-resolver-smc-addr> | adnl <adnl-addr> | text <string>)" +cr +tab
16
    +"delete <subdomain> cat <cat-id>" +cr +tab
17
    +"drop <subdomain>" 
18
    disable-digit-options generic-help-setopt
19
  "t" "--timeout" { parse-int =: timeout } short-long-option-arg
20
    "Sets expiration timeout in seconds (" timeout (.) $+ +" by default)" option-help
21
  "o" "--output" { =: savefile } short-long-option-arg
22
    "Sets output file for generated initialization message ('" savefile $+ +"' by default)" option-help
23
  "h" "--help" { usage } short-long-option
24
    "Shows a help message" option-help
25
parse-options
26

27
$# 2 < ' usage if
28
2 :$1..n
29

30
$1 =: file-base
31
$2 parse-int dup =: contract-id 32 fits ' usage ifnot
32
{ contract-id (.) $+ } : +contractid
33

34
{ $* @ dup null? { second $@ ! } { drop } cond } : @skip
35
{ $* @ null? } : @end?
36
{ $* @ uncons $* ! } : @next
37
@next @next 2drop
38

39
variable Actions
40
{ Actions @ cons Actions ! } : register-action
41

42
{ @end? abort"subdomain name expected" @next dup $len 127 > abort"subdomain name too long"
43
} : parse-domain
44
{ @end? abort"category number expected" @next (number) 1 <> abort"category must be integer"
45
  dup 256 fits not abort"category does not fit into 256 bit integer"
46
  dup 0= abort"category must be non-zero"
47
} : parse-cat-num
48
{ @end? abort"`cat` expected" @next "cat" $= not abort"`cat` expected" parse-cat-num
49
} : parse-cat
50
{ @end? abort"smart contract address expected" 
51
  @next false parse-load-address drop triple
52
} : cl-parse-smc-addr
53
{ @end? abort"adnl address expected"
54
  `adnl @next parse-adnl-addr pair
55
} : cl-parse-adnl-addr
56
{ @end? abort"subdomain record value expected" @next
57
  dup "smc" $= { drop `smc cl-parse-smc-addr } {
58
  dup "next" $= { drop `next cl-parse-smc-addr } {
59
  dup "adnl" $= { drop cl-parse-adnl-addr } {
60
  dup "text" $= { drop `text @next pair } {
61
    "unknown record type "' swap $+ +"'" abort
62
  } cond } cond } cond } cond
63
} : parse-value
64
{ ."Loading new code BoC from " dup type cr
65
  file>B B>boc
66
} : load-new-code-from
67
{ @next dup "add" $= { drop `add parse-domain parse-cat parse-value 4 tuple register-action } {
68
  dup "delete" $= { drop `delete parse-domain parse-cat triple register-action } {
69
  dup "drop" $= { drop `drop parse-domain pair register-action } {
70
  dup "upgrade" $= { drop `upgrade @next load-new-code-from pair register-action } {
71
    "unknown action '" swap $+ +"'" abort
72
  } cond } cond } cond } cond
73
} : parse-action
74
{ { @end? not } { parse-action } while } : parse-actions
75
parse-actions
76

77
file-base +".pk" load-keypair nip constant wallet_pk
78
file-base +"-dns" +contractid +".addr" load-address
79
2dup 2constant smc_addr
80
."Managed manual DNS smart contract address = " 2dup .addr cr 6 .Addr cr
81

82
."Actions: " Actions @ list-reverse .l cr
83

84
// ( S -- S1 .. Sn n )
85
{ 1 swap { dup "." $pos dup 0>= } { $| 1 $| nip rot 1+ swap } while drop swap
86
} : split-by-dots
87
// ( S -- s )
88
{ dup $len dup 0= abort"subdomain cannot be empty" 126 > abort"subdomain too long"
89
  dup 0 chr $pos 1+ abort"subdomain contains null characters"
90
  split-by-dots <b {  // ... S b
91
    swap dup $len 0= abort"empty subdomain component" $, 0 8 u,
92
  } rot times b> <s
93
} : subdomain>s
94
// ( b V -- b' )
95
{ dup first
96
  dup `smc eq? { drop untriple 2swap drop x{9fd3} s, -rot Addr, 0 8 u, } {
97
  dup `next eq? { drop untriple 2swap drop x{ba93} s, -rot Addr, } {
98
  dup `adnl eq? { drop second swap x{ad01} s, swap 256 u, 0 8 u, } {
99
  dup `text eq? { drop second swap x{1eda01} s, over $len 8 u, swap $, } { 
100
    abort"unknown value type"
101
  } cond } cond } cond } cond
102
} : value,
103
{ subdomain>s dup sbits 3 >> 
104
  dup 63 > { drop s>c dict, } { rot swap 7 u, swap s, } cond
105
} : subdomain,
106
// ( A -- b )
107
{ dup first
108
  dup `add eq? {
109
    drop 4 untuple <b swap value, b> -rot
110
    <b 11 6 u, swap 256 u, swap subdomain,
111
    swap dict, nip } {
112
  dup `delete eq? {
113
    drop untriple rot drop
114
    <b 12 6 u, swap 256 u, swap subdomain, } {
115
  dup `drop eq? {
116
    drop second <b 22 6 u, swap subdomain, } {
117
  dup `upgrade eq? {
118
    drop second <b 9 6 u, swap ref, } {
119
  abort"unknown action type"
120
  } cond } cond } cond } cond
121
} : action>b
122
// ( -- b )
123
{ Actions @ dup null? { drop <b 0 6 u, b> } {
124
  uncons swap action>b { over null? not } {
125
    b> swap uncons swap action>b rot ref,
126
  } while nip } cond
127
} : serialize-actions
128
serialize-actions
129
dup brembits 888 < { b> <b 0 6 u, swap ref, } if
130
dup =: actions-builder b>
131
."Serialized actions are " <s csr. cr
132

133
// create a message
134
// create external message
135
now timeout + 32 << actions-builder b> hashu 32 1<<1- and + =: query_id
136
<b contract-id 32 i, query_id 64 u, actions-builder b+ b>
137
dup ."signing message: " <s csr. cr
138
dup hashu wallet_pk ed25519_sign_uint
139
<b b{1000100} s, smc_addr addr, 0 Gram, b{00} s,
140
   swap B, swap <s s, b>
141
dup ."resulting external message: " <s csr. cr
142
2 boc+>B dup Bx. cr
143
."Query_id is " query_id dup . ."= 0x" X. cr
144
."Query expires in " timeout . ."seconds" cr
145
savefile tuck B>file
146
."(Saved to file " type .")" cr
147