Ton

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

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

7
"dns-msg-body.boc" =: savefile
8

9
begin-options
10
     " <auto-dns-addr> [-o<savefile-boc>] (add|update|prolong) <subdomain> <expire-in-sec> ... " +cr +tab
11
    +"Creates the internal message body containing a request to automatic DNS smart contract <auto-dns-addr> created by new-auto-dns.fif, "
12
    +"to be sent later with a suitable payment from a wallet to <auto-dns-addr>, and saves it into <savefile-boc> ('" savefile $+ +"' by default). "
13
    +"The operation to be performed is one of" +cr +tab
14
    +"add <subdomain> <expire-in-sec> { owner <smc-addr> | cat <cat-id> (smc <smc-addr> | next <next-resolver-smc-addr> | adnl <adnl-addr> | text <string>) }" +cr +tab
15
    +"update <subdomain> <expire-in-sec> { owner <smc-addr> | cat <cat-id> (smc <smc-addr> | next <next-resolver-smc-addr> | adnl <adnl-addr> | text <string>) }" +cr +tab
16
    +"prolong <subdomain> <expire-in-sec>"
17
    disable-digit-options generic-help-setopt
18
  "o" "--output" { =: savefile } short-long-option-arg
19
    "Sets output file for generated initialization message ('" savefile $+ +"' by default)" option-help
20
  "h" "--help" { usage } short-long-option
21
    "Shows a help message" option-help
22
parse-options
23

24
$# 4 < ' usage if
25
4 :$1..n
26

27
$1 true parse-load-address =: bounce 2=: dest-addr
28
$2 dup =: main-op-name atom =: main-op
29
$3 dup =: subdomain $len 127 > abort"subdomain name too long"
30
$4 parse-int dup 30 1<< < { now + } if =: expire-at
31

32
{ $* @ dup null? { second $@ ! } { drop } cond } : @skip
33
{ $* @ null? } : @end?
34
{ $* @ uncons $* ! } : @next
35
{ @next drop } 4 times
36

37
main-op dup `add eq? over `update eq? or swap `prolong eq? or
38
{ "unknown main operation '" main-op-name $+ +"'; one of 'add', 'update' or 'prolong' expected" abort } ifnot
39
main-op `prolong eq? not =: need-params
40

41
$# 4 > need-params <> abort"extra parameters, or no parameters for chosen main operation"
42

43
variable Values  dictnew Values !
44
// ( i c -- )
45
{ over 0= abort"category cannot be zero"
46
  <b swap ref, swap Values @ 256 b>udict!+ not abort"duplicate category id"
47
  Values !
48
} : register-value  
49

50
{ @end? abort"category number expected" @next (number) 1 <> abort"category must be integer"
51
  dup 256 fits not abort"category does not fit into 256 bit integer"
52
  dup 0= abort"category must be non-zero"
53
} : parse-cat-num
54
{ @end? abort"smart contract address expected" 
55
  @next false parse-load-address drop
56
} : cl-parse-smc-addr
57
{ @end? abort"adnl address expected"
58
  @next parse-adnl-addr
59
} : cl-parse-adnl-addr
60
{ <b x{9fd3} s, -rot Addr, 0 8 u, b> } : serialize-smc-addr
61
{ <b x{ba93} s, -rot Addr, b> } : serialize-next-resolver
62
{ <b x{ad01} s, swap 256 u, 0 8 u, b> } : serialize-adnl-addr
63
{ <b x{1eda01} s, over $len 8 u, swap $, b> } : serialize-text
64
{ @end? abort"subdomain record value expected" @next
65
  dup "smc" $= { drop cl-parse-smc-addr serialize-smc-addr } {
66
  dup "next" $= { drop cl-parse-smc-addr serialize-next-resolver } {
67
  dup "adnl" $= { drop cl-parse-adnl-addr serialize-adnl-addr } {
68
  dup "text" $= { drop @next serialize-text } {
69
    "unknown record type "' swap $+ +"'" abort
70
  } cond } cond } cond } cond
71
} : parse-value
72
{ @next dup "owner" $= { drop -2 cl-parse-smc-addr serialize-smc-addr } {
73
  dup "cat" $= { drop parse-cat-num parse-value } {
74
    "unknown action '" swap $+ +"'" abort
75
  } cond } cond
76
  register-value
77
} : parse-action
78
{ { @end? not } { parse-action } while } : parse-actions
79
parse-actions
80

81
// ( S -- S1 .. Sn n )
82
{ 1 swap { dup "." $pos dup 0>= } { $| 1 $| nip rot 1+ swap } while drop swap
83
} : split-by-dots
84
// ( S -- s )
85
{ dup $len dup 0= abort"subdomain cannot be empty" 126 > abort"subdomain too long"
86
  dup 0 chr $pos 1+ abort"subdomain contains null characters"
87
  split-by-dots <b {  // ... S b
88
    swap dup $len 0= abort"empty subdomain component" $, 0 8 u,
89
  } rot times b> <s
90
} : subdomain>s
91

92
main-op ( _( `add 0x72656764 ) _( `update 0x75706464 ) _( `prolong 0x70726f6c ) )
93
assq-val not abort"unknown main operation"
94
=: op-id 
95

96
."Automatic DNS smart contract address = " dest-addr 2dup .addr cr 6 .Addr cr
97

98
."Action: " main-op .l subdomain type space expire-at . cr
99
."Operation code: 0x" op-id 8 0X. cr
100
."Value: "
101
Values @ dup null? { drop ."(none)" } { <s csr. } cond cr
102

103
<b op-id 32 u, expire-at 32 u, Values @ dict, b> =: actions-builder
104

105
// create an internal message
106
now 32 << actions-builder hashu 32 1<<1- and + =: query_id
107
<b op-id 32 i, query_id 64 u,
108
   subdomain subdomain>s tuck sbits 8 / 7 i, swap s,
109
   main-op `prolong eq? { Values @ ref, } ifnot
110
   expire-at 32 u, b>
111
dup ."Internal message body is: " <s csr. cr
112
2 boc+>B dup Bx. cr
113
."Query_id is " query_id dup . ."= 0x" X. cr
114
savefile tuck B>file
115
."(Saved to file " type .")" cr
116